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PREFACE 

This  document  contains  Appendices  B  through  H  of  the  Omega  Sys¬ 
tem  Performance  Assessment  and  Coverage  Evaluation  (PACE)  Workstation 
Design  and  Implementation  repon.  The  appendices  provide  code  listings  of 
the  PACE  software.  Discussions  about  the  listings  contained  herein  are  pro¬ 
vided  in  Section  5  of  Volume  1. 
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This  appendix  contains  the  Pascal  code  listings  for  the  range/bearing  to  cell  format  database 
version  program.  A  discussion  of  this  program  is  provided  in  Section  5.1. 


File  Name;  RBCXM72.SRC 


Hie^RBj30NV2  progi^viises.**ihesfoldowijTg?:source: 
progBi^^i-files^-a^wel'l  -,as''other“"PAGE-xmits: 

RBCX»IV2.PAS 

CDNV_DB.PAS 

DCMJCDE.PAS 

GETJWSIS.PAS 

LD_NOISE.PAS 

IDAmEF.PAS 

LDADJRB.PAS 

IDGIO.PAS 

PACE_RB.PAS 

PHASE.  PAS 

FO^.PAS- 

QKSOPT.PAS 

SNRimS.PAS 

SNRSHORT.PAS 

X  ANGIE.  PAS 
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File  Name:  RECC»JV2.PAS 


{*********************************************************************** 


*  *- 

*  PROGRAM  NAME  -  Omega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME  -  RBenTO2  Program  * 

*  * 
A*********************************************************************** 

*  * 

*  Ihis  program  was  prepared  hy  * 

•k  k 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IS-I  PC/AT  or  corpatible  * 

*  under  MS-DOS  3.3  or  higher  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  conpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (ONSCEN) ,  Alexandria,  VA.  * 

*  ★ 
************************************************************************ 

*  * 

*  PURPOSE  * 

*  Program  to  convert  the  range/bearing  database  to  the  cell  * 

*  format  database  used  ky  PACE.  * 

*  * 

k  k 


kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk j 

PROGRAM  RB_OONVERT; 

U&*ES  Crc,  Dos; 

{ 

$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 

Convert  Range-Bearing  Data  to  Matrix  form 

Ver  0  05/06/88  KAIteydi  Convert  a  single  file  as  defined  by  constants 

Med  1  11/88  DPFrank  Read  and  process  data  from  reformatted  Range/ 

Bearing  fil'=-3 

Ver  2  05/30/90  KATench  Version  for  PACE  files 

Ver  3  10/90  EMAustvold  Updated  version  for  PACE  files 

To  generate  "real"  data  for  each  station 
Added  irdates  from  PMorris 
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File  Name:  RBa»IV2.PAS 


Ilife«pfecediire“'is  'to*  generat!e«a-  largej:ten^raiiy''ldae>:v*i±^^ 
organized  as:  oa  6a  oa 

Station*  Month*  Hour*  Cell 
aa  M  aa 

(  Ihe  loading  and  interpolating  of  Range/Bearing  data  is  best  this  way) 

Ihe  last  st^  is  to  access  this  file  and  convert  it  to  one 
organized  as:  6a  6a  6a  . 

Cell*  Station*  Month*  Hour 
aa  aa  aa 

(  Ihe  most  efficient  way  for  PACE  to  access  it  ) 
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 


) 

CONST 


nois^ath 

rbpath 

outpath 

dbname 


=  '\pace\rbconv2\noise\' ; 
=  'D:V; 

=  '\pace\rbconv2\pacedb\'; 
=  '102CCIVDB.4M^• 


freq  =  102 ; 

SNRJEHRESHOLD  *  799;  (*  99.9  *  8  =  799.2  vhich  rounds  to  799  *) 

(*  8  is  the  resolution  of  1/8  of  a  dB  *) 
(*  99.9  represents  the  maximum  airplitude  *) 
(*  tiiat  our  signals  will  reach  *) 
(*  used  in  the  caiputation  of  the  Short  *) 
(*  and  long  path  SNR  conputation  *) 


{$!  OCNV_DB.PAS  } 
{$!  PACE_RB.PAS  } 


TiTE 


atan_ptr  =  ^mg_atan; 
Nei^iborsiype  =  array[1..4] 


VTIype 

CovCells 

Noiseiype 


=  array[l. .4] 

=  array [1.. 444] 


of  atonjTtr; 

{  pointers  to  nearest  nei^Tbor  atoms  } 
of  Real; 

{  weights  for  the  nearest  nei(^ibors  ) 
of  CovCell; 


=  array[l. .444,1. .24]  of  Integer; 


VAR 

icell, 

imonth, 

CMflag, 

tnpMlBIR, 

MUMR 

Neighbors 


:  integer; 

:  Nei^iborsiype; 


File  Name:  RBOONV2.PAS 


w- 

:  WP/pe;- 

Delta_Bearing, 

Delta_Range 

:  Real; 

Ihe_Cell 

Cell_Defn_ptr; 

Teiip_RB, 

Trail_RB 

RB_ptr; 

Sum 

Real; 

CovSum 

integer; 

fcell 

file  of  Cell_Recx)rd; 

cellfname.-. 

string[40] ; 

fINTP 

text; 

fOOV 

text; 

ftenp 

file  of  CovCells; 

Cell 

CovCells; 

ffinal 

file  of  coviorec_4m; 

d 

coviorec_4m; 

fKX3 

text; 

Noise 

NoiseType; 

TEMPFTLENME 

string; 

gmtstr 

string; 

{$!  QKSQRT.PAS} 

{$!  ID_NOISE,PAS  } 
{$!  PCWER.PAS} 

{$!  liDGlO.PAS} 

{$!  IDADDEF.PAS  } 
{$!  lOADJRB.PAS  } 
{$!  GEr_WGIS.PAS  ) 
{$!  SNRSHORT.PAS  ) 
{$!  SNRLDNG.PAS  ) 
{$!  HiASE.PAS  ) 

{$!  X_ANGLE.PAS  } 
{$!  DCMJCDE.PAS  } 


BEGIN 

Gridsize  :=  lO; 

RB__List  ;=  nil; 
Cell_Defn_List  :=  nil; 
Assign(fLOG,  'PB_OONV.IDG')  ; 
Rewrite  (flCG) ; 


Assign(fteiro,  outpath+'Tenp.$$$') ;  Rewrite ( ftenp)  ; 

IF  lOResult  o  0  Ihen 
BEGIN 

writeln; 

writeln(chr(7) ,  '///  Enror  opening  OTTFOT  file  ///•)  ; 
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File  Name:  RBa»JV2.PAS 


HSiecir; 

Hfe'; 


{  loop  on  stations  } 

for  selectedjStation  :=  1  to  8  do  {  locp  on  stations  } 
begin 

TextColor(7+selected_Station) ; 

Load_Cell_Def inition  (  Selected_Station, 

GridSize, 


Cell_Defn_Iist, 

NuntojCells) ; 

for  iMonth  :=  1  to-  4  do  {  loop  on  months  } 


begin 

Month  :=  (iMonthrl)  *3  +  2;  {to  get  2,5,8  and  11  } 

load_noise_data  (Month,  Noise) ; 

for  GMT  ;=  1  to  24  do  {  Loop  on  hours  } 


BEGIN 

{$1-} 

Reset(flDG)  ; 

($1+) 

If  lOResult  =  0  Then 
Begin 

Close  (flCG) ; 
^:pend(fIDG) ; 

Ena 


Else 

Rewrite  (fUDG) ; 

Load_Range_Bearing_Data(  SelectedjStation, 

Month, 

GMT, 

Ereq, 

RB_List) ; 

IhejCell  Cell_DefnJLiist; 

CovSum  :=  0; 

VJriteln; 


FOR  icell  :=  1  to  nunibjoells  IX)  (  Loop  on  Cells  } 

BEGIN 

IF  (icell  MGD  10)  =  0  THEN 
V?rite('#') ; 

GetWei^ts(Neighbors,W,'Ihe_Cell,Ten?jRB,Trail_RB) ; 

Ccjtputelhase (Neighbors, W, Cell, icell) ; 

ICLIMR  :  =  CcmciuteDam_Mode  (Nei^ibors ,  W,  Cell ,  icell ) ; 
CaipiteSNRShort  (Nei^Tbors ,  W,  Cell ,  Noise  [  icell ,  OIT] ,  icell ,  MIIMR)  ; 
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File  Name:  RB0:»JV2.PAS 


QaipiteSNRLDng(Nei^ibors,W,Cell,Noise[ic«ll,(2^r]',icell,MLlHR) ; 
CcaipiteXJ^le(Ihe_Cell,  Cell 4call,Selected_Station, Month, GMT)  ; 


{(Dutpit  SNR  Information  by  Cell) 

(*  *************************** 

if  ((icell  =  1)  or  ((icell  MDD  50)  =  0))  AND 
( (GOT  =  1)  or  (C2C  =  12)  or  (OC  =  24) )  then 
begin 

if  (icell  =  1)  then 
begin 

STR(Oir,gmtstr) ; 

TEMPFILENAME  ;=  'HTTP*  +  gnitstr  +  '.COT'; 

Assign  (fINIP,TEMPFIIINAME) ; 

Rewrite  (flNTP) ; 
end; 

if  (icell  >  1)  then 

writeln(fINTP,chr($C)) ;  {  page  eject  ) 

Writeln(fINTP, 'Station  =  Selected  Station); 

Writeln(fINrP,  'Month  =  ' , Month)  ; 

Wrlteln(fINTP,'GMT  =  SCOT); 

Writeln(fINTP,'  lat  Ion  '); 

Writeln(fINrP, '  cell  cntr  cntr  1st  2nd', 

'  Fhsdev  X  Angle  (CM  =  0  if  mode  1  dominant 

Writeln(fINTP, 'Cell  Range  (Mm),  Bearing,  deg  ,  deg  ,  Rad,  Rad', 

',  ^SNR(dB),  Ip-SNR,  (cecs),  (degs) ,  EM,  MIIMR')  ; 
Writeln(flNrP) ; 

END; 

if  (((MT  =  1)  or  (QC  =  12)  or  (CMT  =  24))  then 
begin 

trrpMlIMR  :=  (Get_Sigma (Cell [icell]  .SNR_S)  SHL  4)  OR 
Get_Sigma (Cell [icell]  .SNR_L)  ; 

if  ( (Cell [ icell ].Ihase  AND  $80)  =  0)  then 
EMflag  :=  0 
else 

EMflag  :=  1; 

Writeln(fINrP,  icell:3, 

'Ihe_Cell'' .  Range/100  ;  8 : 3 , 

'Ihe_Cell^ .  Bearing/10  : 13 : 1 , 

(The_Cell'' .  IatCenterihRadians*57 . 29578 )  :  8 ;  2 , 

(The_Cell^ .  IjonCenterinRadians*57 . 29578 )  :  8 : 2 , 
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File  Name;  RBa»IV2.PAS 


TaifPRB'="tRBi=Be^ing'^ 

:9V 

Tf^_RB*vRBVBearih^. 

:7; 

GetjSNR(Cell[icell]  .SNR_S)/8 

:8:1, 

Get_SNR(Cell [icell] .SNR_L)/8 

;11;1 

(Cell [icell]. Ihase  AND  $7F) 

:6, 

Cell [icell] ,X_Ang 

:9/ 

EMflag 

:6, 

tupMUMR/lO 

:7;l) 

*******************************************  *) 

'Ihe_Cell  Ttie_cell''.ne3ct; 

END;  {FOR  icell} 

write  (ftertp,  Cell) ;  {  put  the  batch  of  cells  into  a  file  } 

writeln; 

(* 

if  (GC  =  1)  or  (O^T  =  12)  or  (GMT  =  24)  then 
close  (fINTP) ; 

*) 

END;  {  FOR  ) 

END;  {  FOR  iiDonth  ) 

END;  {FOR  selectedJ5tation  ) 

Close  (ftaip) ; 

Assign (f final,  out^sath+dbname) ;  Rewrite (f final) ; 

{  Open  and  massage  the  tenporary  file  into  the  output  format  } 

Writeln  ('Converting  the  tenporary  file  .  .  .'); 

FOR  icell  ;=  1  to  Numb_Cells  DO  EBGH^ 

Write(iCell:4) ; 

Reset  (ftenp) ; 

FOR  selected_Station  :=  1  to  8  DO  BEGIN 
FOR  imonth  :=  1  to  4  DO  BEGIN 
FOR  C3C  ;=  1  to  24  DO  BEGIN 
Read(fteirp,  Cell) ; 
d[imonth,C3fl']  :=  Cell  [icell ] ; 

END;  {on?) 

END;  {imonth} 

V^rite(f final,  d) ; 

END;  (Station) 

Close(fteirp) ;  {  so  we  can  reopen  it  at  rhe  beginning  } 

END;  (icell) 

Close (f final)  ; 

END. 
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File  Name:  CCm  DB.PAS 


^*********************************************************************** 


*  * 

*  fKXSElSM  NAME  -  Omega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NaME'-  Part  of  •  the-sRBOONV2  program  * 

*  * 

*  ifc 

*  This  prcgram'^'wasi  prepared  -by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massadiusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IM  PC/AT  or  conpatible  * 

*  under  MS-DOS  3.3  or  higher  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccatpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Ctenter  (O^SCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  HJRPOSE  * 

*  Collection  of  cell  definition  variables  and  structures  that* 

*  are  used  in  converting  from  the  range/bearing  database  to  * 

*  the  cell  format  database.  * 

*  * 


************************************************************************) 

CONST 

MAXATCMS  =  200; 

digits  ;  array[0..9]  of  char  =  ('O', '1', '2', '3', M', '5', '6', '7', '8', '9') 

MAXSORTLENGTH  =  1000; 

NUMSTANDARD_RADIAIS  =  36; 

TYPE 

mg_atan  =  RECORD 

Range  ;  Integer;  {  megameters  } 

SHClAirp  :  Integer;  {  Short-path  Mode  1  Anplitude  (dB)  } 

SHUPhase  :  Integer;  {  Short-path  Mode  1  Phase  (cecs)  } 

SPKSumAnp  :  Integer;  {  Short-path  Mode  Sum  Anplitude  (dB)  } 

SPMSumPhase  :  Integer;  {  Short-path  Mcde  Sum  Phase  (cecs)  ) 

IH4SumAi!p  :  Integer;  {  long-path  Mode  Sum  Anplitude  (dB)  } 

END; 
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File  Name:  CDNV  DB.PAS 


RECORD- 

fearing  :  Integer; 

X_Angle  :  Integer; 

a  ;  array [ 0.  .MMaiCMS]  of  mg_atcsn; 

END; 


{  deg*10  } 

{  crossing  angle  ) 

{  the  range  atans  } 


RB_ptr  =  ^RBJiold; 

RB_Hold  =  REODRD 

next  :  RB_ptr; 

NumAtons*-;  Integer; 
RB  :  RB_Record; 

END; 


{  for  linked  list  storage  in  memory  } 
{  Actual  #  of  atcms  with  data  } 


RB  =  RECORD. 

Range  :  Integer; 

Bearing  :  integer; 

END; 

Cell_Defn  =  RECORD 
Latl, 

Lat2  ;  Integer; 
lonl, 

Lon2  ;  Integer; 

xlate  ;  array[l.,8]  of  RB; 

Wei^t  :  Integer; 

END; 


{  in  10  km  steps  ) 

{  note:  (10  km  *  100)  =  1  megameter  ) 
{  degrees  *  10  } 


{  S,N  extents  in  deg*10  ) 

{  W,E  extents  in  deg*10  ) 

{  range/bearing  of  cell  center  ) 
{  relative  to  each  transmitter  ) 
{  wei^t  for  ccmputing  coverage) 


Cell_defn_ptr  =  ''Cell_defn 
Cell_defn_hold  =  RECORD 

next  ; 

Latl,Iat2  : 

Ionl,Lon2  : 

LatCenterInRadians , 
LonCenterInRadians  ; 
Range  : 

Bearing  : 

XI,  X2  : 

Yl,  Y2  : 

Vfei(^t  : 

END; 


hold; 

{  structure  for  memory  linked  lists  } 
Cell_defn_ptr; 

Integer;  {  S,N  extents  in  deg*10  ) 

Integer;  {  W,E  extents  in  deg*10  } 

{  center  of  cell  -  in  radians  ) 
real;  {  EAST  >  0,  WEST  <  0  } 

Integer;  {  in  10  km  steps  } 

{  note:  (10  km  *  100)  =  1  megaroeter  ) 
real;  {  deg  *  10  } 

Integer;  {  Correspond  to  lonl,  Ion2  ) 

Integer;  {  Correspond  to  Latl,  Lat2  ) 

Integer;  {  vei^t  for  computing  coverage) 


Cell_Record  =  RECORD 

SNR_Short  :  Integer; 
SNR_Iong  :  Integer; 
Riase_dsv  :  Byte; 
DomJHode  :  Byte; 
X_Angle  :  Integer; 


(  For  matrix  (gridded)  data  ) 

{  short-path  SNR  in  dB*10  ) 

{  long-path  SNR  in  d3*10  ) 

{  Phase  deviation  in  cec  ) 

{  fJornber  of  the  Dominant  mode  ) 
(  Crossing  Angle  in  deg*10  ) 
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File  Name;  COW  DB.PAS 


Coverage  :  Integer; 

END; 

SortList  =  array [  1.  .MAXSORIIENGIH]  of  integer;  {Sort  Buffer  for 

Qksort  Procedure) 

VftR 

RB_List;  RB_Ptr; 

Cell_Defn_Li£t;  Cell_E>2fn_j3tr; 

Cells:  array[l. .1800]  of  Cell_record; 

Nuinb_Cells;  Integer; 

Selected_Station; Integer;  {  1='.A,  2=B,  etc..} 

GridSize;  Integer;  {  basic  cell.,  size*. ) 

Month:  Integer;  {  Month  number:  1  =  Jan,  2=Feb,  etc.  } 

GMT:  Integer;  {  (3C  hour  12  =  1200z  ) 

SNRthreshold;  real;  {  SNR  threshold  for  coverage  corputation  } 

PhaseDevIhreshold;  real;  (  Phase-Deviation  threshold  for  coverage  conputation) 
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{*****^'**;***9t*.*****,*****#***iit***'******,*****:*‘*w********************?ir^,**i^» 


* 

* 

* 

* 

* 

* 

* 

* 

•k 


FROQlftM  NAME  -  Omega  Performance  Assessment 

and 

Coverage  Evaluation 
(PACE) 

workstation 

UNIT  NAME  -  Part  of  the  RBCCNV2  Program 


* 

* 

* 

* 

* 

* 

* 

* 

* 


*************************************************************************** 


* ' 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 


Uiis  -program  was  prepared  by 

Ihe  Analytic  Science  Corporation  (TASC) 

55  Walkers  Brook  Drive 
Reading,  Massachusetts  01867 

PACE  has  been  developed  to  run  on  a  lEM  PC/AT  or  ccmpatible 
under  MS-DOS  3.3  or  higher  with  a  minimum  of  640K  of  main 
memory  and  an  EGA  or  ccupatihle  graphics  adapter  and  color 
monitor.  This  work  was  performed  under  contract  number 
nroS23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for 
the  Onega  Navigation  System  Center  (CNSCEN) ,  Alexandria,  VA. 


* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 


************************************************************************ 


*  * 

*  H3RP0SE  * 

*  Ciis  file  contains  the  code  for  computing  the  mode  1  * 

*  dominance  margin  and  the  Mode  1  dominance  flag.  * 

«  * 

*  * 
***************************************************x'».'*******************^ 


function  CcaTpjteDcra_Mode(  Nei^ibors  ;  Nei^iborsT^’pe; 

W  :  Wiype; 

var  Cell  ;  CovCells; 

icell  :  integer  ) :  integer; 

{ 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  As  part  of  the  range/tearing  to  cell  format  database  * 

*  conversion,  coipute  the  mode  1  dominance  margin  and  flag.  * 

*  Ihe  mode  1  flag  is  set  if  mode  1  DOES  NOT  dominate  the  * 

*  interfering  mode  signals  by  at  least  6  dB  (as  hardcoded  * 

*  below) .  * 


★A********************************************************************** 
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File  Name:  CCM  MDDE.PAS 


) 

$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 
ver  ■  0  11/90  EMAustvold 

We  will  cxsrpute  the  ratio  between  Model  and  the  Interfering  tfcdes 
and  store  that  in  Model_to_Interferin^fcdeI?atio.  This  ratio  is  then 
cntpared  to  the  I^aiunantModeOlireshold  which  will  allcw  1:1s 
to  set  the-Doninant  Mode  flag. 

(  1  bit  flag  =  1  if  Mode  1  is  NOT  daninant 
=  0  if  Mode.  1  IS  daninant  ) 

if  (Model_to_Interfering^^odeRatio  <  DatdimtModeThreshold)  then 
Set  the  flag 

The  Dominant  Mode  f].ag  is  the  hipest  bit  in  the  Phase  Deviation  byte. 
Again,  algorithms  are  courtesy  of  PHtorris. 

$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 

} 

const 

Dcminant>kx3efIhreshold  =  6,0;  (*  in  dB  *) 

var 

Sum  ;  Peal; 

i  ;  Integer; 

Model_to_Interlerir>^*!odePatio  :  real; 

DeltaX, 

Deltalhi  :  Real; 

begin 
Sum  :=  0; 

for  i  :=  1  to  4  do 
begin 

{ ***************** 

Note:  DeltaRii  is  divided  by  100  because  we  need  the  result  of 
SHiLPhase  -  SPMSumPhase  to  be  in  cycles,  not  canticycles. 
***************** } 

DeltaThi  :=  (Nei^Tbors[i]''.SHILHiase  -  Neighbors [i]^. SFMSuraIhase)/100 ; 

^  ***************** 

Note;  DeltaX  is  divided  by  10  because  we  need  the  result  of 
SnCLAitp  -  SPMSumAnp  to  be  in  dB,  not  10*dB. 

***************** } 
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File  Naiie:,  DOODDE.PAS 
DeltaX‘':=* 

Sum  :=  Sum  +  (DeltaX  -  (10  *  IDG10(  (1  +  Pcwer(10,DeltaX/10.0)  - 

(2  *  POWER(l0,DeltaV20.0)  *  cxs (2*pi*DeltaIhi)  )))))  *  W[i] ; 

end; 


Model_txi_Interferin^^fcxieRatio  :=  Sum; 

(*  clip  the  value,  of-  the  dcmuiicUTt:, mode; -between  0  and  25  dB  *) 

if  Model_to_InterferingModeRatio  >25.0  then 
Model_to_Int^eringM5deRatio!  ;*?  25; 0; 

if  ^toiel_to_Interferin(^ModeRatio  <0.0  then- 
Model_to_InterferingModeRatio  :=  0.0; 

if  (Model_to_InterferingModeRatio  <  DminantModeOhreshold)  then 
Cell [icell]. Phase  :=  Cell [icell] .Phase  OR  $80;  (*  mode  1  not  dominant  *) 

(*  note:  Ctominant  mode  flag  =  1  if  NOT  dominant  mode  *) 

(*  and  =  0  if  dominant  mode  *) 

ConpjteDcmJtode  :=  round (Model_to_InterferingMcdeRati^  *  10) ; 

(*  ModelJx)_Interfering^fcd6iRatio  is  multiplied  by  10  here  *) 
(*  so  that  we  may  insert  this  value  into  the  database  as  *) 
(*  a  number  between  0  and  250.  We  can  fit  this  value  into  *) 
(*  1  byte  (range  0..255)  and  we  can  then  give  ourselves  *) 
(*  resolution  of  1/10  of  a  dB.  *) 

end; 
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^ *********************************************************************** 


*  * 

*  FRDC3?AM  NAME  -*  Omega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evalmtion  * 

*  (PACE)  * 

*  workstation  * 

*  * 

*  UNIT  NAME  -  Pa2±  of  the  RBCCX^V2  Program*  * 

*  * 

*************************** ********************************************** 
*  * 

*  Ihis  program  was  pr^jared  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Beading,  Massachvisetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  coipatible  * 

*  under  MS-DOS  3.3  or  higher  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  compatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  nr0323-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Onega  Navigation  System  Oenter  (C^ISCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  HM^OSE  * 

*  Routine  to  carpute  the  relative  weights  of  the  database  * 

*  values  that  are  to  be  interpolated  to  the  ce3,l  center.  * 

*  * 

*  * 

procedure  GetWeights  (VAR  Neighbors  :  Nei<^±orsType; 

VAR  W  ;  Wiype; 

The_Cell  ;  Cell_defnjptr; 

VAR  Tenp_RB,Trail_RB  :  RB_Ptr) ; 


{ 

************************************************************************ 


*  * 

*  HJRPOSE  * 

*  Find  the  appropriate  weights  to  use  to  perform  the  four  * 

*  comer  (bilinear)  interpolation  to  get  a  value  for  the  cell* 

*  center.  * 


************************************************************************ 

} 

{ 


B-15 
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ver  0  05/88  Kaitench 

ver  1  11/90  EMAustvold 

1  :  Seardi  throui^  the  range/bearing  list  for  2  bearings, 

one  vMch  is  just  greater  than  the  bearing  fron  the  station  to  the 
cell  center  and  one  vMch  is  just  less  than  the  bearing  from  the 
station  to  the  cell  center. 

2  :  Corpute-  the  wei^ts  of  each  bearing*.  (hi(^er  weight  means  the-- 

bearing.',  is  closer,  to  the  actual  bearing  of  the  ^station  to  the  .  cell 
center)" 

3  :  Seardi  throu*^  the  2  radials  viiidi  bound  the  cell  center  and  find 

2  range  points  diich  new  bound  the  cell  center. 

4  :  Cotpute  the  wei^ts  of  each  range  point  as  it  conpares  in  distance 

from  the  cell  center,  (hi^er  wei^t  means  that  the  point  is 
closest  to  the  cell  center) 

Note:  range  bearing  data  is  assumed  to  be  sorted  into  ascending  order 


$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 

) 

•var 

i  :  integer; 
sum  :  real; 

begin 

Tenp_RB  ;=  BBJList; 

WHILE  (Tertp_PB  o  nil)  AND 

(Tenp_RB^.RB. Bearing  <  'Ihe_Cell^.Bearing/10)  DO 

BEGIN 

Trail_RB  :=  Tenp_RB; 

Temp_RB  ;=  Tertp_RB''.next; 

END; 


{  get  delta  Bearing  and  catpute  bearing  part  of  wei^ts  } 


IF  Teirp_RB  =  nil  THEN 
BEGIN  {  wrap  around?  ) 

Terrp_RB  :=■  PB_List; 

Celta_Eearing  :=  ((Tenp_R3''.PB. Bearing  +  360)  -  Trail_RB''. RB. Bearing) ; 

W[3]  :=  1~( ( (Tstp_RB^ .RB.Bearingr360)-a3ie_Cell'' .Bearing/10) /Delta_Eearing) ; 
END 
ELSE 
BEGIN 
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DeltaJBearirg-,  :=  (TenpJRB^.RB. Bearing)  -  (Trail_RB^.KB.-Bearing),; 

W[3]  :=  l-((Teitp_RB^.RB. Bearing  -  Ihe_Cell^ .Bearing/10) /Delta_Bearing) ; 
END; 

W[l]  :=  l-CCIhe^Cell^. Bearing/10  -  TrailJ?B^.PB.Bearir>3)/Delta_Bearing) ; 
W[23  :=  W[l]  ; 

W[4]  ;=W[3]; 

{  seardi  each  radial  for  the  range  atcans  vhich  are  closest  } 


12/23/88  Note:  Hiis  code  DOES  NOT  correctly  deal  with  the  case 

where  the-  cell  range  is  less  than  the<  iidnirnumsatcm 
range  on  either  the  Trail  or  the  Tenp  radial  vhich 
bractet  the  cell  center.  At  the^. present,  this  prob¬ 
lem  is  not  corrected.  Hcwever  the  "Near-Field"  test 
given  belcw  eliminates  this  prciblem  for  the  Range/Bear 
ing  data  used  for  the  Hawaii  coverage  effort. 


(* 

Note:  In  the  following  code,  Cell^. Range  is  only  divided  by  10  so  that  it 
will  be  in  the  same  units  as  the  range  which  is  read  in  from  the 
range  bearing  file 


*) 


i  :=  1;  (*  START  IHE  CXmT  AT  1  BECAUSE  THE  0th  RECORD  IS  MEANINGLESS  *) 

(*  BECAUSE  IT  DOES  NOT  CONTAIN  ANY  VAIID  DATA.  *) 

WHILE  (i  <=  Trail_RB^.NumAtans)  AND 

(Trail_RB^.Rb.a[i] .Rarge  >  0)  AND 
(Trail_RB^.RB.a[i] .Range  <  (The_Cell''. Range/10))  DO 

BEGIN 
Inc(i)  7 
END; 

IF  (i  >  Trail_RB''.NumAtoms)  OR  (Trail_RB^.RB.a[i] .Range  <  0)  THEN 
Dec(i) ;  {  went  too  far.  back  ) 

Neii^±ors[23  :=  Addr(  Trail_RB^.RB.a[i3) ; 

IF  i  >  1  THEN 
BEGIN 

Nei^horsCl]  :=  Addr(  Trail_RB".RB.a[i-13)  ; 

Delta_Range  :=  Nei(^Tbor£[2]^.Range  -  Neighbors [1]''. Range; 

W[l]  :=  W[l]  *  (Nei^}bors[2]^.Range  -  The_Cell''. Range/10) /Del ta_Range; 
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W{;2].  :=  W(!2,]'  *'*-('niS^CeH::^/Raiige;ao:.- l?e!ighBGrsOi],''.|?arig§)5(fDelta;^^^ 
END 
EISE 

{  gp-TI  range  identical  to  first  range  point; 

use  the  first  range  point  and  set  the  second  weight  to  zero} 

BEGIN 

Neighbors[l]  :=  Mar(  Trail JRB^.KB.a[i])  ; 

W[2]  ;=  0; 

END; 


i  :=  1; 

WHILE  (i  <=  Trall_J?B^  .NumAtans)  AND 

(TenpJRB;i:.RB;^a[i.]..Range  '>  0)  AND, 

(TenpJRBi^.RB‘ia[4]  .R5UTgev<'Thej2C^l''..Range/10)  DO... 

Inc(i) ; 

IF  (i  >  Trail_RB^.NumAtcms)  OR  (TenpJRB^.RB.a[i] .Range  <  0)  THEN 
Dec(i) ;  {  went  too  far.  back  igj  } 

Nei^ibors[4]  :=  Addr(  Tenp_RB^.RB.a[i]) ; 


IF  i  >  1  THEN 
BEGIN 

Nei^^bors[33  :*=  Addr(  Tenp__RB^.RB.a[i-l]) ; 

Dslta_Range  :=  Nei^Tbors[4]''.Range  -  Nei^±ors[3]^.Range; 

W[3]  :=  W[3]  *  (Neighbors [4]^. Range  -  The_Cell^.Range/10)/Delta_Range; 
W[4]  ;=  W[4]  *  (The__Cell''. Range/10  -  Nei^ibors[3]^.Range)/Delta__Range; 
END 
ELBE 

{  Cell  range  identical  to  first  range  point; 

use  the  first  range  point  and  set  the  second  weii^t  to  zero) 

BEGIN 

Nsi(^lx5rs[3]  ;=  Addr(  Tenp_RB''.RB.a[i]) ; 

W[43  :=  0; 

END; 

(*********************************************** 
sum  :=  0; 

for  i  :=  1  to  4  do 


BEGIN 

WRITEIN(fICG, 'W[',i:l/]  =  ',W[i]); 
SUM  :=  sum  +  W[i] ; 

END; 


writeln(fIOG,  'Wl  +  W2  +  W3  +  W4  =  ',sum) ; 
************************************************) 


END; 
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{ ***************************************************  A  •  ‘-‘•**************** 


*  * 

*  NAME  -  Onega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  WorJcstation  * 

*  * 

*  UNIT  NAME  -  Part  of '  the- RBG0NV2  Program  * 

*  * 

************************************************************************ 
*  * 

*  Hais  program  was  prepared  by  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  lEM  PC/AT  or  corpatible  * 

*  under  MS-DOS  3.3  or  hi(^er  with  a  minimum  of  640K  of  main  * 

*  meanory  and  an  EGA  or  corpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DrCG23-89-C-20008,  Task  Order  90-0001,  Thsk  No.  5834,  for  * 

*  the  Onega  Navigation  System  Center  (ONSCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  This  file  contains  the  utility  procedures  necessary  * 

*  to  load  the  cell-format  noise  data  that  is  used  to  * 

*  construct  the  short  and  long-path  signal  to  noise  ratio  * 

*  (SNR)  values  for  the  PACE  database.  * 


************* *********************************************************** j 

procedure  load_noise_data  (Month  :  Integer;  var  Noise:  NoiseType) ; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  This  routine  reads  the  noise  data  for  a  particular  month  * 

*  fron  the  various  noise  database  files.  * 


************************************************************************ 

} 

{ 

$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 
ver  0  11/90  EMAustvold 
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procedure  reads  in  noise  data  v^ch  is  organized  by 
cell  (1. .NumbjCells)  and  by  hour  (OCT  1..24).  The  data  is  stored  in 
a  record  Noise  [CellNum,HourNum]  and  is  used  to  ccsipute  the  Signal 
to  Noise  ratio  for  both  the  Short  Path  Anplitude  and  the  Long  Path 
Amplitude. 

Note:  the  value  which  is  read  in  is  the  (Noise  *  10) . 

(ie.  real  noise  value  ->  23.9  =  239  <-  read  in  fran  file  as  this) 

At  the  present  time/  only  the  noise  files-  for  February,  May,  August, 
and  November  are  used  to  calculate  noise.-  The  reason-  for-  this  is  so  that 
we  may  interpolatei-the  remaining' -8  months  fron  these  4  months,  as  directed 
by  PE^torris,Jand..RRGl;pta. 

Note:  This  will  have  to  be  changed  in  the  future  so  that  each  month 

and  hour  in  the  final  database  will  use  the  corresponding  noise  data 
for  that  month.  Only  the  Signal  Amplitude  will  be  interpolated,  not 
the  noise  data.  Hiis  change  will  probably  ta]<e  place  in  'the  program 
MAKE12M.PAS. 

$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 

) 


NoiseFileName  :  string;  (*  the  Noise  file  name  *) 
IriRec  :  string[30];  (*  record  read  in  from  the  Noise  file  *) 
fNoise  :  text;  (*  Noise  file  *) 
i,j,k,  (*  index  for  reading  past  header  *) 
Code,  (*  error  code  returned  from  val  funct.  *) 
CellNum,  (*  Cell  number  *) 
HourNum,  (*  Hour  number  *) 
IntTenpl  :  integer;  (*  temporary  conversion  number  *) 
fre<^tr  :  string; 


begin 

str(freq!3,freqstr) ; 
case  Month  of 

2:  NoiseFileName  :=  Noisepath  +  'N_FEB. '  +  freqstr;  (*  FEEREARY  NOISE  *) 

5:  NoiseFileName  :=  Noisepath  +  'N_MAY. '  +  freqstr;  (*  MAY  NOISE  *) 

8:  NoiseFileName  :=  Noisepath  +  'N_AUG.'  +  freqstr;  (*  AUGUST  NOISE  *) 

11:  NoiseFileName  :=  Noisepath  +  'N_NOV. '  +  freqstr;  (*  NOVEMBER  NOISE  *) 

else 

NoiseFileName  :=  Noisepath  -i-  'N_F£B. '  +  freqstr;  (*  FEBRUARY  NOISE  *) 
end;  (*  case  stmt  *) 

{$!-) 
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Assign  (fNoise,  NoiseEileNaroe) ; 

Reset  (fNoise) ; 

{$!+} 

if  (lOResult  =  0)  then  (*  no  file  error  *) 

begin 
writeln; 

Writeln( 'Reading  NOISE  file  ',NoiseFileNaiie, '  .  . 

Write('%<) ; 

for  CellNum  :=  1  to  NuirbjOells  do 
begin 

if  CellNum  =  1  then  (*  if  processing,  a  new  file  then  *) 

begin  (*  read-pasb  the^  25  lines  of'  header  *) 

for  k  :=  1  to  . 25  do- 
readln (fNoise,  Inrec) ; 

end; 


if  ( (CellNum  mod  10)  =  0)  then 
Write('~') ; 

for  HourNum  ;=  1  bo  24  do 
begin 

Readln (fNoise,  Inrec) ; 

Val(Copy(Inrec,13,4) ,  IntTenpl,  Ccxle) ; 

if  (Code  =  0)  then  (*  no  error  in  string  conversion  *) 

Noise  [CellNum,  HourNum]  :=  IntTenpl 
else 
begin 

writeln (flDG,  **************** f'j ; 

writeln (flOG,  'Error  reading  Noise  file:  ',NoiseFileName) ; 

writeln(fIDG, 'CellNum  =  ',CellNum:4) ; 

writeln(fIDG,  'HourNum  =  ', HourNum: 4) ; 

writeln (flDG, 'Value  read  in  from  file  ==  ''', Inrec, ''^') ; 

writeln(fIDG,  'Noise  has  been  assigned  the  value  of  zero. ') ; 

writeln  (fiJDG,  '****************) ; 

Noise[CellNum, HourNum]  :=  0; 
end; 
end; 
end; 

Close  (fNoise) ; 

assign (fnoise,  'noise. tnp') ; 

rewrite ( fnoise) ; 

for  i  :=  1  to  Numb_cells  do 

begin 

for  j  :=  1  to  24  do 
write(fnoise,Noise[i,j]:5) ; 
writeln  (fnoise) ; 
end; 
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CIb^ffN6ise)x; 

*) 

end 

else  (*  error  in  opening  file  *) 
begin 

Writeln(chr(7) ,  V//  Noise  file  •'^,NoiseFileName, not  found  ///'); 
Halt(l)  ; 
end; 
end; 
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^ ***********************************************************************'- 


*  * 

*  PROGRAM  NAME  -  Qiiega  Barformance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME  -  Part,  of  the<  RBOCNV2  Program'  * 

*  * 

*************************************************************************** 
*  * 

*  This  program  was  pr^jared.  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  develcped  to  run  on  a  IM  PC/AT  or  conpatible  * 

*  under  MS-DOS  3,3  or  hi^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  corpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DrCG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Onega  Navigation  System  Center  (ONSCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  This  file  contains  the'  routines  that  are  used  by  the  * 

*  range/bearing  to  cell  format  database  conversion  code  to  * 

*  define  the  10  by  10  degree  cell  grid.  * 

*  * 


************************************************************************} 

(**************************************************************************) 


procedure  GenerateCellCenterInRadians(  var  Cell  :  Cell_Defn_Ptr) ; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  For  a  given  cell,  find  the  lat/lon  of  the  cell  center.  * 

*  * 


) 


(* 

$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 


ver  0  11/02/90  EMAustvold 
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OliLs'  procedure'c'sbould  use^thfe'^NortRij  Soifch;  EaM.)'  and-'We^-  -ext&ts 
which,  are  supplied  by  the  Cell  vhich  is  passed  in.  The  extents 
are  in  (degrees  *  10)  and  shcxd.d  be  used  to  create  the  cell  center 
in  radians  with  (East  >  0) ,  (West  <  0) ,  (North  >  0)  and  (South  <  0) . 

exaiiple  of  algorithm  ; 


latl 

lat2 

lat  center 

20 

30 

25 

10 

20 

15 

0 

10 

5 

-10 

0 

-5 

-20 

-10 

-15 

$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 

*) 

const 

radiansperdegree  =  0.0174533; 
var 

latcenter, 
loncenter  ;  real; 

begin 

latcenter  :=  (Cell''.latl  +  abs(Cell''.lat2  -  Cell''.latl)/2)/10; 
loncenter  ;=  (Cell^.lonl  +  abs(Cell^.lon2  -  Cell''.lonl)/2)/10; 

Cell^.IonCenterlnRadians  :=  loncenter  *  radiansperdegree; 

Cell''.IatCenterInRadians  ;=  latcenter  *  radiansperdegree; 

end; 


(**************************************************************************) 


PROCEDURE  Ioad_Cell_Definition(  station, 

cellsize  ;  Integer; 

VAR  Cell__Defn_List  :  Cell_defn_ptr; 

VAR  Nunib_Cells  :  Integer) ; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  load  the  10  by  10  degree  cell  definitions  into  the  * 

*  data  structure  i:ised  by  RECa^V2.  Similar  to  a  routine  * 

*  that  is  contained  in  the  loadjdef.pas  program  file.  * 


***********************************************************************x 

) 

{ 
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$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$, 

Load  cell  definition  for  indicated  station  and  cellsize  into  memory  as  a  _ 
list  attached  to  the  pointer  Cell_Defn_List.  Cellsize  is  the  basic  size 
(size  at  ttje  equator)  in  degrees  (e.g. ,  5,  10). 

NumbjCells  is  set  to  the  number  of  <oells  read  in. 

Ihe  format  of  the  file  name  is:  C3?ID_nn.DEF 

Where  nn  is  the  basic  cell  size  in  degrees 

Ver  0  05/88  KM?ench 

Ver  1  05/90  KMtench  Added  Cell_Defn_List  Disposal  (for  P_RBConv) 

Ver  2  11/90  EMAustvold 

$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$5$$$$$5$$$$$$$$$$$$$$$$ 

} 

VAR 

Odefn&iame:  string[40] ; 

Last_Cell,  Tenp_cell:  Cell_defn_Ptr;  {  (oell  definition  list  } 

Tenp_Cell_Defn:  Cell_defn;  {  for  reading  in  the  definition  ) 

fOdefn:  file  of  Cell_Defn; 
i:  Integer; 


BEGIN 

{  Clear  out  the  old  list  if  need  be  ) 
Last__Cell  :=  Cell_Defn_List; 

WHni  Last__Cell  o~nil  DO  BEGIN 
Tenp_Cell  :=  Iast_Cell''.next; 
Dispose  (lastjCell) ; 

Iast_Cell  :=  Tenp_Cell; 

END; 


{  figure  out  the  name  of  the  file  to  use  ) 

Cdefnfname:='GRID_'+DIGITS[Cellsize  div  10 3+DIGrrs [Cellsize  mod  10]+'.DEF'; 
{  Read  in  and  store  the  cell  definition  file  ) 

Writeln; 

Writeln('Loadii^  Cell  Definition  .  .  .'); 

{$i“) 

Assign (fOdefn,  Cdefnfname) ;  Reset (fCdefn) ; 

{$!+} 

IF  lOResult  =  0  THEN  BEGIN 


Read(fCdefn,  Teiro_cell_defn) ; 

New(  Cel]_De&i_List  ) ; 

Cell_Defn_List'' .  latl  :=  Teiip_cell_defn.latl; 
Cell_Defn_List^.lat2  :=  Teiip_cell_defn. Iat2 ; 
Cell_Defn_List^ .  lonl  :=  Teirojcell_defe.lonl; 
Cell_Defn_List'' . lon2  :=  Tenp_cell_defn.lon2; 
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CellJDefr^List^ .  raf^^-  ir^’Toip^csll^defnVxlatefStiaM^  range>' 

rpl  1_T^-fn_Tjst^  .bearing  :=  Tenp_cell_de&i.xlate[Station]  .bearing; 
GenerateCellCenfcerIriRadians(Cell_Defii_List)  ; 

LastjCell  :=  Cell_Defn_List; 

Nunib_Cells  :=  1; 

WUriE  NOT  EOF{fOdefn)  DO  BEXHN 
Inc(NumbjCells) ; 

N6W(  TenpjCell  ) ; 

Read(fCdein>  Tenp^celljdefe).;  {  get«a'-new«definition  and  store  away  } 
Ten?)j::ell^.latl'  ;=  Tenpj.cell_defnilatl; 

TenpjCell ^.lat2  Teirp£_celljlefn.lat2; 

TenpjCell'^ .  loiiL..  :=-Tenpjqelljaefn-.lonl ; 

TenpjCelK' . lon2  :—-Tenpjcelijlefn.lon2 ; 

Tenp_Cell^. range  Tenp_celljaefn.xlate[Station]  .range; 

Tenp_Cell^. bearing  ;=  Tenp_celljaefn.xlate[Station]  .bearing; 
GenerateCellCenterInRadians(Teiip_Cell) ; 

Last_cell''.next  :=  Tenp_cell;  {  link  new  one  into  the  list  } 
lastjcell  :=  Tenp_cell; 

END; 

Last_cell^.next  ;=  nil;  {  mark  the  last  link  as  the  end  ) 

Close  (fCJdefn) ; 

{print  the  list  to  the  screen  to  see  if  it's  in  memory  OK  } 

(* 

Tenp_Cell  :=  Cell__Defn_List; 

i  :=  0; 

repeat 

Inc(i) ; 

WITH  Tenp_Cell^  DO  BEGIN 

Write(i:4,'  Lats  ' , (Latl/10) :7;1,  (Lat2/10) :7:1) ; 

Write('  Ions  (lonl/10) :7;1,  (Ion2/10) :7;1) ; 

Writeln('  !  Station  lyB;  (Range/100) : 6: 2,  Bearing: 7 : 1) ; 

END; 

Tenp_Cell  ;=  Tenp_Cell''.ne>ct; 

UNTIL  Tenp_Cell  =  nil; 

*) 

END 

EISE  BEGIN 

Writeln(chr(7) ,  V//  Cell  Definition  File  ''',Cdefnfnaiie, not  found  ///'); 
Cell_Defn_List  ;=  nil; 

Numbjcells  :=  0; 

Halt(l)  ; 

END; 


File  Name:  I£iAD  RB.PAS 


I*********************************************************************** 


*  * 

*  JROa?AM  NAME  -  Cmega  Perf omance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME  -  Part  of  'die-  PBOONV2  Program  * 

*  * 

*  * 

*  Ihis  program- was  pr^^ared  * 

*  * 

*  Die  Analytic  Science  Corporation  (TASC)  * 

+  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  compatible  * 

*  under  MS-DOS  3.3  or  higher  with  a  miniinum  of  640K  of  main  * 

*  memory  and  an  ESA  or  compatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  nrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Onega  Navigation  System  Center  (C^SCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Diis  file  contains  utility  code  to  read  and  parse  the  * 

*  radial  format  signal  data  needed  by  the  range/bearing  to  * 

*  cell  format  database  conversion  program.  * 

*  * 


************************************************************************ j 


PRXEEURE  LDad_Range_Eearing_Data  (  Station,  Month,  QC, 

Freg:  Integer; 
VAR  RB_List;RB_Ptr)  ; 


{ 


************************************************************************ 


*  * 

*  PURPOSE  * 

*  Construct  the  arprqpriate  range/bearing  data  file  name,  * 

*  read  in  the  range/bearing  data  and  parse  the  irput  data  * 

*  to  obtain  the  desired  signal  quantities.  * 


************************************************************************ 


) 

{ 

$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 
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Ver^rl  05/88r. 

ver  ‘2  11/88'“  DPFiaiik'^  ireforinat^;^  Range^^  file 

ver  3  05/90  KMtench  adl^  RBJList  disposal  and  hardwired:  sta  C 

&  added  file  name  creation  from  input  parans 
ver  4  10/90  EMAustvold  Remove  hardwired  station  C. 

This  version  should  hardwire  the  month  of 
February. 

ver  5  11/90  EMAustvold  Qiange  to  read  new  data  irput  format 

Hardwired  NonStandardRadials 

new  format  ; 

line.  1-6  is- header  information 

ST^v ^m=Feb> GJffieOl  S^PA3:Hr.BEAR=000  PRB3=10i2 

DIS  SFMl  SHCL  SIMS  SPMS  LEMS 
AMP  EHS  AMP  PHS  AMP 

*10  *10  *10  *10 

MM  DB  CEC  DB  CEC  DB 

0  999  0  999  0  -999 

lines  7  -  number  of  radials  contains 'data- in  the  columns 

cols  (01  -  04)  -  distance  along  radial  in'  tenths  of  a  MegaMeter 

( ie  1*0.1,  2*0.2,...  ) 
cols  (05  -  09)  -  Short  Path  Mode  1  Anplitude  (dB) 

cols  (10  -  14)  -  Short  Patii  Mode  1  Phase  (cecs) 

cols  (15-19)  -  Short  Path  Mode  Sum  Anplitude  (dB) 

cols  (20  -  24)  -  Short  Path  Mode  Sum  Phase  (cecs) 

cols  (25  -  29)  -  Long  Path  Mode  Sum  Anplitude  (cecs) 

$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 

} 

const 

NumberOfNonStandardRadials  =  14; 
type 

NonStandardRadialiype  = 

array [1.  ,8,1.  .NumberOfNcnStaixiardRadials]  of  integer; 

(*  8  stations  x  14  possible  NonStandardRadials  *) 

const 

NumberRecordsPerRadial  =  201;  (*  records  numbered  0  -  200  *) 

StepsizeAlongRadial  =  0.10;  (•'»  one  tenth  of  a  megameter  *) 

NonStandardRadials  :  NonStandardRadialiype  = 

(*A*)((  45,  225,  105,  285,  115,  295,  000, 

000,  000,  000,  000,  000,  000,  000  ), 

(*  B  *)  (  17,  197,  156,  336,  165,  345,  175, 
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355> 

178, 

358, 

000  > 

000,; 

000,. 

000 

); 

(* 

c 

*) 

( 

5, 

185, 

25, 

205, 

27, 

207, 

152, 

332, 

163, 

343, 

167, 

347, 

000, 

000 

), 

(* 

D 

*) 

( 

8, 

188, 

34, 

214, 

44, 

224, 

165, 

345, 

000, 

000, 

000, 

000, 

000, 

000- 

), 

(* 

E 

*) 

( 

13, 

193, 

23, 

203, 

148, 

328, 

155, 

335, 

167, 

347, 

174, 

354, 

000, 

000 

), 

(* 

F 

*) 

( 

5, 

185, 

16, 

196, 

22, 

202, 

152, 

* 

332, 

175, 

355, 

178, 

358; 

000, 

000 

), 

(* 

G 

*) 

( 

5, 

185, 

18, 

198, 

165, 

345, 

173, 

353, 

000, 

000, 

000, 

000, 

000, 

000- 

), 

(* 

H 

*) 

( 

2, 

182, 

5, 

185, 

26, 

206, 

165, 

345^ 

172, 

352, 

175, 

355, 

000, 

000 

)  ) 

VAR 

Iest_RB, 
TenpJRB  : 

fRB  : 

fDIAG  : 

RBfname  : 

i,j,k  ; 

Inrk:  : 

RBFileName  : 

RealTenp  : 

IntTenpl  : 

Code  : 

Radials  : 

NumberRadials: 
freqstr, 
MorrthName  : 

stationstr  : 


RB_Ptr;  {  station  range-bearing  data  list  ) 

text; 

text; 

string[40] ; 

integer; 

string  [80] ; 

string  [40] ; 

real; 

integer; 

integer; 

SortList; 

integer; 

String[3] ; 
string[l] ; 


BEGIN 

{  Dispose  of  old  list  if  need  be  } 
Last_RB  :=  RB_List; 

WHUE  Iast_RB  o  nil  DO  BEGIN 
Tenp_RB  ;=  Last_RB^.next; 

Dispose (Iast_RB) ; 

Iast_RB  :=  Teiro_RB; 

END; 


{ 

Generate  file  name  of  the  form  sronimtt.fff 
vhere: 


s  =  sta 
mnrni  =  month 
tt  =  air 
fff  =  frequency 


(A,B,C,D,E,F,G,H) 
(PIB,MAY,ADG,NOV) 
(01.. 24) 

(102  or  136) 


(  4  months  we're  concerned  with.) 
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csase^'Month^of 


1 

MonthName* 

=  'JAN'' 

2 

MonthName 

=  'FEE' 

3 

MonthName 

=  'MAR' 

4 

MonthName 

=  'APR' 

5 

MonthName 

=  'MAY' 

6 

MonthName 

=  '3UN' 

7 

MonthName 

=  'JUL' 

8 

MonthName 

=  'ADG' 

9 

MonthName 

=  'SEP' 

10 

MonthName 

=  'OCT' 

11 

MonthName. 

=  'NOV' 

12 

MonthName- 

=  'DEG' 

else 


MontKName  :=  'XXX'; 
end;  (*  case  stmt  *) 

str(freq:3,freqstr  ); 

statjonstr  :=  chr (ord (digits [station]) +16) ; 

RBFileName  ;=  ttjpath  + 

stationstr  + 

MonthName  + 
digits[GMr  DIV  10]  + 
digits[GMr  MOD  10]  + 

'.'  + 
freqstr; 


{$!-} 

Assign (fRB,  RBFileName) ; 

Reset (fRB) ; 

{$!+} 

if  (lOResult  =  0)  then  (*  no  error  *) 

begin 
writeln; 

Writeln( 'Reading  Range/Bearing  file  ', RBFileName, '  .  .  .'); 

{Assign  Bearings  for  "Standard"  Radials) 

For  i  :=  1  to  NUMSTANnARD_RADIALS  Do  (*  36  standard  radials  *) 
Radials[i]  :=  10*(i-l);  (*  0..350,  every  10  degrees  *) 

[ *********************************************************  j 

(Irpjt  Bearings  for  "Additional"  Radials  } 

I ********************************************************  j 

NumberRadials  :=  NUMSIANDARD_RADIAIS; 
i  :=  1; 

While  (i  <=  NumberOfNonStandardRadials  )  and 
(NonStandardRadials [ Station , i ]  o  0)  Do 
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BEGIN 

Kadials[NUMSTANEiARD_K^  ;=  NorStandart3Radials  [Station;  i] ; 

Inc(i) ; 

END; 


NumberRadials  :=  NUMSIANDARDJRADIALS  +  (i-1)  ; 


{Sort  Radials  if  Necessary} 

If  (NumberRadials  >  NUMSTANDAI®_iUU3IALS) 
Qlcsort(Radials,  1,  NumberRadials)  ; 

{ ******************************* } 

(Process  Range/Bearing  Records; } 

{ ****************************** } 

Write('@') ; 

for  j  :=  1  to  NuitiberRadials  do 
begin 

V?rite('.') ; 

New(  Teirp_jRB  ) ; 

TenpJRB''.NumAtaiis  ;=  NumberRecordsPerRadial; 

If  j  =  1  Ihen 
BEGIN 

RB_List  :=  TenpJRB; 

Iast_RB  :=  RB_List; 

END 

Else 

BEGIN 

Last_Pi5^.next  ;=  Tenp_RB; 

Iast_RB  :=  Teiip_RB; 

END; 


Tenp_RB^.RB. Bearing  :=  Radials[j]; 

For  i  :=  0  to  (NuniberRecordsPerRadial-l)Do 
BEGIN 

if  i  =  0  then  (*  if  processing  a  new  radial  then  *) 

begin  (*  read  past  the  6  lines  of  header  *) 

for  k  :=  1  to  6  do 
readln(fRB,  Inrec) ; 

end; 


Readln(fRB,  Inrec) ; 

Val(Cq3y(Inrec,l,4) ,  IntTenpl,  Cede); 
if  (Cede  =  0)  then 
Teirp_RB^.RB.a[i3 .Range  :=  Intifenpl 
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el-se^.' 

begin 

writeln(i, j) ; 

wribeln(£log, ^ *************** ^) j 

writeln(flog,  'Error  reading  Range  Bearing  file:  ',RBFileNaine) ; 
writeln(flog,  'Atteirpting  to  read  Range  values') ; 
writeln (flog, 'Radial  Number  =  ',j:4); 
writeln (flog, 'Record  Number  along  Radial  =  ',i:4) ; 
writeln  (flog,  'Radial  Bearing  =  ',Teiip_RB^. RB.  Bearing:  4) ; 
writeln  (flog, 'Value  read  in  fron  file  =  ^',IntTenpl:4,  "'') ; 
writeln  (flog,  'Range  has  been- assigned  the  value  of  zero. ') ; 
writeln (flog, ^ *************** ^) ; 

Ten?>_RB^^.RB.a[i].Rangeu=  0; 
end-j; 

Val(Cqpy(Inrec,6,4) ,  IntTeitpl,  Code);  {Short-path  Mode  1  Anp) 
if  (Code  =  0)  then 

Tenp_RB^.RB.a[i] .SH€LAnp  :=  IntTeirpl 
else 
begin 

writeln (i,j) ; 

writeln (flog, ^ ***************') ; 

writeln(flog, 'Error  reading  Range  Bearing  file:  '  ,RBFileName)  ; 

writeln  (flog, 'Attenpting  to  read  Short  Path  Mode  1  Amplitude') ; 

writeln  (flog,  'Radial  Number  ®  '/j:4); 

writeln  (flog, 'Record  Number  along  Radial  *  ',i:4); 

writeln  (flog, 'Radial  Bearing  =  ',Tenp_RB''.RB.  Bearing:  4) ; 

writeln  (flog, 'Value  read  in  fron  file  =  ''',IntTenpl:4, '''') ; 

writeln  (flog,  'Short  Path  Mode  1  Artplitude  has  been  assigned  the  value  of  zero. ') 

writeln (flog, ^ ***************') ; 

Tenp_RB^.RB.a[i] .SHCLAmp  :=  0; 
end; 


Val(Ccpy(Inrec,ll,4) ,  IntTenpl,  Code);  {Short-path  Mode  1  Phase) 
if  (Code  =  0)  then 

Tenp_RB^.RB.a[i] .SH41Phase  :=  IntTenpl 
else 
begin 

writeln(i, j) ; 

writeln(flcg, '***************') ; 

writeln(flog, 'Error  reading  Range  Bearing  file:  ',RBFileName)  ; 

writeln  (flog,  'Attenpting  to  read  Short  Path  Mcde  1  Phase') ; 

writeln  (flog, 'Radial  Number  =  ',j:4); 

writeln  (flog, 'Record  Number  along  Radial  =  ',i:4); 

writeln (ilcg, 'Radial  Bearing  =  ', Te!Tp_RB^.R5. Bearing: 4) ; 

writeln (fl 'g, 'Value  read  in  fron  file  =  ^',Intrenpl:4, '^') ; 

writeln(flog,  'Short  Path  Mode  1  Phase  has  been  assigned  the  value  of  zero. ') ; 

writeln (flog, '***************') ; 

Tenp_RB''.RB.a[i] .SPMlPhase  :=  0; 
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end; 

Val(Ccpy(Inrec,16,4) ,  IntTenpl,  Code);  {Short-path  Modesian  Anp) 
if  (Code  =  0)  then 

TeiipJRB^.PB.a[i]  .SHeiffiAitp  :=  Intltenpl 
else 
begin 

writeln(i, j) ; 

writeln(flog, '***************') • 

writeln(flog,  'Error  reading  Range  Bear,ing  file:  '  ,RBFileNaine)  ; 
writeln(flog,  'Attenpting  to  read  Short  Path  Mode  Sum  Anplitude') ; 
writeln (flog, 'Radial  Number  =  ',j:4); 
writeln(flog,  'Record  Number  along  Radial  =  '’,i:4) ; 
writeln (flog, 'Radial  Bearing  =  ',TenpjJRB''.RBiBearing;4) ; 
writeln (flog, 'Value  read  in  frcan  file  =  ^',IntTeirpl:4, '''') ; 

writeln(flog,  'Short  Path  Mode  Sum  Anplitude  has  been  assigned  the  value  of  zero. ') 
writeln (flog, '***************') ; 

Tenp_RB''.RB.a(i]  .srMSumftnp  :=  0; 
end; 

Val(Copy(Inrec,21,4) ,  IntTenpl,  Code);  (Short-path  Modesum  Phase) 
if  (Code  =  0)  then 

Tenp_RB^.RB.a[i] .SFMSumPhase  :=  IntTenpl 
else 
begin 

writeln(i, j) ; 

writeln  (flog,  '**************•* ^)  ♦ 

writeln  (flog, 'Error  reading  Range  Bearing  file;  ',RBFileName) ; 

writeln  (flog,  'Attenpting  to  read  Short  Path  Mode  Sum  Phase') ; 

writeln  (flog, 'Radial  Number  =  ',j:4); 

writeln  (flog, 'Record  Number  along  Radial  =  ',i;4); 

writeln  (flog, 'Radial  Bearings  ',Tenp_RB''.RB.  Bearing:  4) ; 

writeln  (flog, 'Value  read  in  from  file  =  ^',IntTenpl:4, '^')  ; 

writeln  (flog,  'Short  Path  Mode  Sura  Phase  has  been  assigned  the  value  of  zero. ')  ; 

writeln (flog, '***************') ; 

Teitp_RB''.RB.a[i3 .SPMSumPhase  :=  0; 
end; 

Val(Ccpy(Inrec,26,4) ,  IntTenpl,  Code);  (long-path  Itodesum  Aitp) 
if  (Cede  =  0)  then 

Tenp_RB''.RB.a[i] .LEMSunAirp  ;=  IntTenpl 
else 
begin 

writeln(i, j) ; 

writeln (flog, '***************') ; 

writeln(flcg, 'Error  reading  Range  Bearing  file:  '  ,RBFileName) ; 
writeln  (flog,  'Attenpting  to  read  Long  Path  Mode  Sum  Anplitude') ; 
writeln (flog, 'Radial  Number  =  ',j:4); 
writeln (flog, 'Record  Number  along  Radial  =  ',i:4); 
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wELtelh{flogv,  'Radial*.  Begirdngf*='  ■'  ,T3enp^RB%RBABea:firjg::4)sr 
writieiii  (flogf '  Valterre^iir  IfciSiJf i3ter='  '• ,  Intren|>l':4v '  ^  'T  ?" 

writeln(flog,  'Imng  Bath  Mode  Sum  Anplitude  has  been  assigned  the  value  of  zero. ') ; 
writeln(flog, '***************#) ; 

Tenp_RB''.RB.a[i]  .IIMSumAnp  :=  0; 
end; 


END; 

END; 

Last_RB^.next-  ;=  nil; 
Close  (fRB)  ; 


(********************* j 

{ 

Assign(fDIAG,  'DIAG.OtTT')  ; 

Rewrite (fDIAG) ; 

TenpJRB  :=  RB_List; 
writeln; 

Writeln  ( fDIAG ,  Tenp_RB^ .  NumAtons ) ; 

While  (Teitp_RBonil)  Do 
BEGIN 

Writeln('@',  Terip_RB''.RB.Bearing;5) ; 
Writeln(fDIAG,TeirpJRB^.RB.Bearing:5) ; 

For  i  ;=  0  to  (TeitpJlB^.NurnAtans-'l)  Do 
Writeln(fDIAG,i:5,Tenp_RB''.RB.a[i]  .Range;5, 
Teiip_RB''.RB.a[i]  .SFMlAnptS, 
TenpJRB''. RB.a[i3  .SHGBhasezS, 
Tenp_RB'' .  RB .  a  [  i  ] .  SRMSumftitp :  5 , 
Te3jp_RB^ .  RB .  a  [  i  ] .  SIMSumRiase :  5 , 
TeirpJ®''.RB.a[i]  .LEMSinnAiip:5) ; 
Tenp_RB  :=  Tenp_RB^,nejct; 


END; 

Close (fDIAG) ; 

) 

(********************* j 


end  {  Range/Bearing  Processing  } 

else  {  error  reading  file  ) 

begin 

Writeln (chr (7 ),  V//  Range/Bearing  file  ,RBFileNaine/"  not  found  ///'); 

Halt(l) ; 
end; 
end; 
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I*********************************************************************** 


* 

*  FRDGRftM  N^'E  -  Croega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaliiation  * 

*  (PACE)  * 

*  workstation  * 

*  * 

*  UNIT  NME'  ~  Part  of  the^RBGCNV2  Program.  * 

*  * 

**********************★*******•************:******★**************:******■*** 
*  * 

*  This  program  was-pr^3ared  by  * 

*  * 

*  Ihe  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading^  Massachrisetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  compatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  compatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  pjerformed  under  contract  number  * 

*  DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (C»ISCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************* 
*  * 

*  PURPOSE  * 

*  Utility  routine  to  perform  base  10  log.  * 

*  * 

*  * 

*  ★ 


Function  loglO (Value: Real)  :  Real; 

{ 


*  X 

*  PURPOSE  * 

*  Return  the  log  base  10  value  of  the  irput  number.  * 

*  * 


************************************************************************ 

) 

{Function  to  Caipute  the  Base  10  Logarithm  of  •'Value") 

BEGIN 

LoglO  :=  In  (Value) /In  (10.0) ; 

END; 


B-35 


File  Name:  PACE  RB.PAS 


{*****************»)Wk**************************************W**W*#**‘ir*illf.ilWtr^ 


*  EE?OGRftM  NAME  -  Csnega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  ★ 

*  UNIT  NAME  -  Part  of  the  RBOONV2  and  MAKE12M  Programs  * 

★  * 

*  * 

*  This  programrwas. prepared:  by-  '' 

* 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 


*  PACE  has  been  develqaed  to  run  on  a  lEM  PC/AT  or  cotpatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  cr  ccarpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 


*  DIOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (OTSCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  This  file  contains  utility  routines  and  definitions  for  * 

*  the  PACE  10  by  10  degree  cell  database.  THESE  RDUITNES  ARE  * 

*  DUPIICAIES  OF  THOSE  CONTAINED  IN  THE  DAIAUTIL.PAS  PROGRAM  * 

*  FILE  —  THEY  ARE  REPEATED  HEFE  FOR  DEVELOPMENT  PURPOSES  OF  * 

*  THE  RBOONV2  AND  MAKE12M  PROGRAMS.  * 


************************************************************************1 
^  ************************************************************************* 
* 

*  PACE  cell  database  Data  Definitions  and  utility  routines 

* 

*  ver  0  05/90  KATench 

*  ver  1  11/90  EMAustvold 

* 

************************************************************************* j 

TYPE 

{  ceJJ.  coverage  information  for  1  sta/month/hr) 

CovCell  =  RECORD 
SNR_S:  Integer; 

{  Short-path  SNR  (db*8)  w/  SigmajS  in  rmpermcst  nybble  (db*8)  } 
SNR_L;  Integer; 
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{  Long-path  SNR  (db*8)  w/  nothing  in  i^permost-  nibble  } 
Phase:  Byte; 

{  Phase  Deviation  with  mode  1  flag  in  tqp  bit  (0=^fode  1)  } 
X_Ang:  Byte; 

{  Crossing  Angle  ) 

END; 


{  record  for  disk  I/O  -  4  months,  24  hours  of  coverage  information  } 

{  Disk  file  is  organized  as  8  stations  worth  of  coviorec  for  each  of  444  cells  } 
coviorec_4m  =  array[l. .4,1. .24]  of  CovCell; 

coviorec_12m  =  array[1..12,1..24]  of  CovCell;  {  12  month  version  ) 

{  Noise  data  information  for  1  month/hr  } 

NoiseCell  =  RECORD 

Sigma_N:  Byte;  {  Noise  standard  deviation  (db*8)  ) 

Noise:  Byte;  {  Noise  value  (db*8)  ) 

END; 


{  record  for  disk  I/O  -  12  months,  24  hours  of  noise  information  ) 
{  Disk  file  is  organized  as  444  cells  worth  of  noiseiorec  ) 
noiseiorec  =  array[l. .12,1..24]  of  CovCell; 


{  Routines  to  pack  and  ur^jack  the  fields  of  CovCell  } 

FUNCnc^  Pack  SNR(Sigma,  SNR: Integer) :  Integer; 

{ 

*  * 

*  PURPOSE  * 

*  Pack  the  sigma  value  into  top  nibble  of  the  SNR  word  in  the* 

*  cell  format  signal  database.  Ihe  sigma  value  is  actually  * 

*  half  of  the  mode  1  dcminance  margin  byte  value  * 

*  as  documented  in  the  PACE  final  report.  Ihe  variable  called* 

*  sigma  is  shifted  left  by  12  bits  and  ORed  into  the  SNR  * 

*  value.  * 

************************************************************************ 

) 

{  Pack  the  sigma  value  into  top  nibble  of  SNR  } 

BEGIN 

P^ck_SNR  :=  ((Sigma (*-12*))  SHL  12)  OR  (  SNR  AND  $FFF) ;  {12  =  1.5*8  db) 

END; 


FUNCnCN  Get_SNR(SNR_in:  Integer) :  Integer; 

{ 

:^*:^f*********:ir********'***************'********:TX**i^erif:)t*****:fc**-)l:*****:itf:lr*x**5t'* 

*  X 

*  PURPOSE  * 

*  Remove  the  lower  three  nibbles  of  information  from  a  word  * 
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lengt^?.vari^leAwithra> quantity.  paciked?dntQ;.ititevi:5:{)^  * 

*  nia31e-  (tfje- foaif  bit^)';.  Sign''extena*by«^fHiling^^^  * 

*  the  t:5per  nibble  vdth  cxies  if  the  v^^per  bit  of  the  third  * 

*  nibble  (bit  #  12  is  set) . 

St*********************************************************************** 

) 

(  remove  the  tcp  n^tble  and  sign  extend  to  make  a  full  integer  } 

BEGIN 

SNR_in  :=  SNR_in  AND  $FFF; 

IF  {SNR_in  AND  $800)  o  0  IHEN'-  {  Need  to  extend,  sign  bit  ?  } 

Get_SNR  :=  SNR^in  OR  $F000 

else 

Get_SNR-  :=  SNRf_in; 

end;: 

FUNCTION  Gat__Sigma(SNR_in:  Integer):  Integer; 

{ 

*************************************************************************** 

*  * 

^  xr\JS\r\jo)L  ^ 

*  Remove  the  value  stored  in  the  upper  nibble  of  a  word  value* 

*  by  masking  off  the  lower  12  bits  and  then  shifting  the  * 

*  result  ri(^t  by  12.  * 

***ii*iiii****ii*1t**iiic*******-kifk**itit**1t**1t*1t***********it***it***it******1t***** 

} 

{  Extract  sigma  fron  top  n^ttole  } 

BEGIN 

Get_Sigraa  :=  ((SNR_in  AND  $F000)  SHR  12) (*+12*)  (i.e.,  1.5*8); 

END; 
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^ *********************************************************************** 


*  *■' 

*  PESDGRAM  NAME  -  Omega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME  -  Part  of  the  RBOONV2  Program  * 

*  * 


*************************************************************************** 


*  * 

*  Hiis  program  was  pr^Dared  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  conpatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  mjjjimum  of  64 OK  of  main  * 

*  memory  and  an  EGA  or  ccnpatible  graphics  adapter  and  color  * 

*  monitor,  Ihis  work  was  performed  under  contract  number  * 

*  DrOG23-89-C-20008,  lask  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (C»ISCEN) ,  Alexandria,  VA.  * 

*  * 


************************************************************************ 


* 


* 


* 

* 

* 

* 

* 


PURPOSE  * 

Hiis  file  contains  the  code  necessary  to  conpute  the  phase  * 
difference  for  the  database  signals.  * 

* 

* 


************************************************************************ j 


procedure  CaTputeFhase(  Nei^ibors  : 

W  : 

var  Cell  : 

icell  ; 


Neighborsiype; 
Wiype; 
CovCells; 
integer  ) ; 


************************************************************************ 


* 

* 

* 

* 

* 


PURPOSE 

Ccmpute  the  phase  deviation  for  the  cell  canter  using  the 
nei^iboring  points  on  the  closest  radials. 


* 

* 

* 

* 

* 


************************************************************************ 

} 
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Algoritto'-tof.  ccsrpute!  -thfe.sphasess- 
dwixition-is  ccwrtesy  of 'PEMSTfisj  Pete. 


var 

Sum,diff  :  Real; 
i  :  Integer; 

begin 
Sum  :=f0; 

FOR  i  ;=  1  to  4  DO 
begin 

diff'  ABS(Nei^TboES[d]''.SPHSuinPhasep- 

Nei^ibbrs  [  i  ]  ^ .  SPt&Phase)  MOD  100 ; 
if  ■  (diff  >  50)  then 
diff  ;=  100.0  -  diff; 

Sum  :=  Sum  +  (diff  *  W[i]) ; 
end; 


Cell [icell] .Phase  ;=  round(Sum) ; 
end; 
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I  ***********************************************************************- 


*  *' 

*  I5?CX3?flM  NftME  -  Onega  Perf onnance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Woricstation  * 

*  * 

*  UNIT  NAME  -  Part  of  the  RBOCNV2  Program'  * 

*  * 

********************■******★★*************************************■****★*'* 
*  * 

*  Hiis  program  -was  prepared  by  * 

*  * 

*  Die  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  conpatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimimi  of  640K  of  main  * 

*  memory  and  an  EGA  or  coipatible  graphics  adapter  and  color  * 

*  monitor.  Diis  work  was  performed  under  contract  number  * 

*  DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  omega  Navigation  System  Center  (ONSCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  HJRPOSE  * 

*  Utility  routines  to  ccmpute  an  exponent.  * 

*  * 

*  * 

*  ★ 


********:*f*******************************************:if *******************  \ 

Function  Power  (Base,  Exponent;  Real)  ;  real; 

{ 

************************************************************************ 


*  * 

*  RJRPOSE  * 

*  Function  to  Catpute  ”Base**Exponent"  * 

*  * 


************************************************************************ 

} 

BEGIN 

Power  :=  E>p)(  E;ponent*In(Base)  ) ; 

END; 
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^****************************************.*********,*.*;k***********;**^*****»t 


*  -  *-'■ 

*  FROGRfiM  NAME  -  Ctaega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME  -  Part  of  the  REC0NV2  Program  * 

*  * 


************************************************************************* 


*  * 

* '  Hiis-  program^  wass  prepared  -by  * 

*  * 

*  Uie  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  conpatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccsipatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  Dr0323-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (CWSCEN) ,  Alexandria,  VA.  * 

*  * 

*************il(***********rt*************************************:>t******** 
*  * 

*  PURPOSE  * 

*  Provides  a  gereral  sorting  routine.  * 

*  * 

*  * 

*  * 


{  Modified  version  of  Borlairi  QSORT  program} 
{$R-) 

{$S-} 


procedure  qksort(var  a:  SortList;  Lo,Hi:  integer) ; 

{ 

************************************************************************ 


* 

* 

* 

* 

* 

* 

* 

* 


* 

PURPOSE  * 

gjICKSORT  sorts  elements  in  the  array  A  with  indices  between* 
ID  and  HI  (both  inclusive) .  Note  that  the  (^JICKSORT  proce-  * 
dure  provides  only  an  "interface"  to  the  program.  Ihe  actual* 
processing  takes  place  in  the  SORT  procedure,  which  executes* 
itself  recursively.  * 

* 
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*  * 
************************************************************************ 


} 


procedure  sort(l,r:  integer)  ; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Sort  is  a  recursive  sorting  procedure  that  sorts  a  list  * 

*  between  the- values  1  and  r.  * 

*  * 

*  * 


************************************************************************ 

} 

var 

i,j,x,y:  integer; 
begin 

i;=l;  j;==r;  x:=a[(l+r)  DIV  2]; 
r^jeat 

vMle  a[i]<x  do  i:=i+l; 
vAiile  x<a[j]  do 
if  i<=j  then 
begin 

y;=a[i];  a[i]:=a[j];  a[j]:=y; 
i:=i+l;  j:==j--l; 
end; 

until  i>j; 

if  l<j  then  sort(l,j); 
if  i<r  then  sort(i,r) ; 
end; 


begin  {qksort); 

sort(Io,Ili) ; 
end; 


t 
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{***:fc*******************************************************************H 


*  *”"■ 

*  ERDGRM!  NftME  -  Onega  Performance  Assessment  * 

*  and  * 

*  CDoverage  Evaliaation  * 

*  (PACE)  * 

*  Wor3«station  * 

*  * 

*  UNIT  NAME  -  Part  of  the.  PBOOJV2  Program  * 

*  * 
************************************************************************ 

*  * 

*  Hiis  program  -was  prepared^ty  * 

*  * 

*  Ihe  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  ccmpatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccmpatible  grajiiics  adapter  and  c»lor  * 

*  monitor.  Ihis  work  was  performed  under  contract  number  * 

*  DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (CNSCEN) ,  Alexandria,  VA.  * 

*  * 
************************************************************************ 

*  * 

*  PURPOSE  * 

*  Hiis  file  contains  the  cxde  to  ccmpute  the  long-path  * 

*  SNR  value  for  the  cell  database  from  the  range/bearing  * 

*  datatbase.  * 

*  * 

**************************************************************************  j 

prccedure  CcaiputeSNRIorig(  Nei^ibors  ;  Nei^iborsiype; 

W  ;  Wiype; 

var  Cell  :  CovCells; 

Noise, 

icell, 

MHMR  :  integer  ) ; 


{ 

*****★*:!  *********'********'*****'**************************'*****'slrdt*’****x'**^ 
*  * 

*  PURPOSE  * 

*  This  procsidure  performs  the  four  (corner  interpolaton  of  the* 

*  radial  data  to  obtain  the  long-path  SNR  at  the  cell  (center.* 
************************************************************************ 

) 
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(* 

ver  01  11/90  EMftustvold 

1.  Find  the  long-path  signal  anplitude  for  each  cell  by  ccarputing 
the  weighted  average  of  the  signal  anplitudes  for  the  closest 
neighboring  points  on  the  adjacent  radials. 

2.  After  converting,  subtract  the  noise  for  the  cell. 

(note:  the.  noise  and  the  ■  signal  anplitude-  are  scaled  by  a-  factor 
of  10,  ie  999  =  99.9) 

3.  After  the  noise  is  subtracted  out,  the  result  is  scaled  by  8  so  that 
we  may  store  the  value  in  increments  of  1/8  dB. 

4.  PacQc  the  SNR  into  the  lowest  1  1/2  tytes  of  the  SNR_L  variable  of 
the  dataset,  (note:  SNRJL  is  an  integer  (2  bytes) .  We  use  the  hipest 

nybble  of  SNRJL  to  store  the  lowest  nybble  of 
the  Model_to_InterferingModeRatio  (MLIMR)  ) 

*) 

var 

Sum  ;  Real; 
i  ;  Integer; 

begin 
Sum  :=  0; 

FOR  i  :=  1  to  4  Do 
begin 

Sum  :=  Sum  +  (Neighbors [ij'^.LEMSumAmp/lO)  *  W[i]; 
end; 

Cell[icell] .SNR_L  :=  RDund(  (Sum  -  (Noise/10))  *  8  ); 

if  Cell[icell].SNR_L  >  SNR_'IHRESHOLD  then 
Cell[icell].SNR_L  :=  SNR_'rHRESHOLD; 

if  Cell[icell].SNR_L  <  -SNR_'IHRESHOID  then 
Cell[icell].SNR_L  :=  -SNR^IHRESHOrD; 

(*  put  the  lower  nybble  of  MUMR  in  the  iroper  nybble  of  the  *) 

(*  long  path  snr  *) 

Cell[icell].SNP^L  :=  Pacik_SNR( (MUMR  AND  $0F) ,  Cell[icell] .SNR_L)  ; 
end; 
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* 

* 

* 

* 

* 

* 

* 

* 

* 


program  name  “  C3niega  PerformaiTce  Assessment 

and 

Coverage  Evalviation 
(PACE) 

Workstation 

UNIT  NAME  -  Part  of  the  RBCI»JV2  Program 


* 

* 

* 

* 

* 

* 

* 

* 

* 


★*********************************************************************** 


*• 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

★ 


This^<pKgramxwas«.pr^)ared''by^ 

Ihe  Analytic  Science  Corporation  (TASC) 

55  Walkers  Brook  Drive 
Reading,  Massachusetts  01867 

PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  catpatible 
under  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main 
memory  and’  an  EGA  or  ccnpatible  graphics  adapter  and  color 
monitor.  This  work  was  performed  under  contract  number 
DIOS23-89-C-20008,  Task  Order  90-0001,  T^k  No.  5834,  for 
the  omega  Navigation  System  Center  (ONSCEN) ,  Alexandria,  VA. 


* 

* 

* 

* 

* 

* 


PURPOSE 

This  file  contains  the  code  that  caipites  the  short-path 
SNR  v^ues  for  the  cell  format  database  from  the  range/ 
bearing  database. 


* 

* 

* 

* 

* 

* 

★ 

* 

* 

* 

* 

* 

* 


************************************************************************ 


•k 

* 

* 

* 

* 

* 


★★****•*  **********************************'*******************tt***********J 

procedure  CaipiteSNRShort(  Neit^ibors  ;  Neighborsiype; 

W  ;  wrype; 

var  Cell  :  CovCells; 

Noise, 

icell, 

MIIMR  ;  integer  ) ; 

{ 

************************************************************************** 
*  * 

*  PURPOSE  * 

*  Routine  to  get  the  cell  center  short-path  SNR  by  performing* 

*  the  four  comer  interpolation  of  the  radial  values,  * 

**************************************************************************** 
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File  Name:  SNRSHQRT.PAS 

ver  01  11/90-  EMAustvold 

1.  Find  the  short~path  signal  anplitude  for  each  cell  by  cotputing 
the  weighed  average  of  the  signal  anplitudes  for  the  closest 
neighboring  points  on  the  adjacent  radials. 

2.  After  converting,  subtract  the  noise  for  the  cell. 

(note:  the  noise  and  the  signal  anplitude-are  scaled 
by  a  factor  of  10,  ie  999  =  99.9) 

3.  After  the  noise  is  subtracted  out,  the  result  is  scaled  by  8  so  that 
we  may  store  the  value:  in  increments  of  1/8  dB. 

4.  Pack  the  SNR  into  the  lowest  1  1/2  bytes  of  the  SNRJS  variable  of 
the  dataset,  (note:  SNR_S  is  an  integer  (2  bytes) .  We  use  the  hipest 

nybble  of  SNRJS  to  store  the  hipest  rabble  of 
the  >fcx3el_to_Interf  erin^todeRatio  (MIIMR)  ) 


*) 

var 

Sum  :  Real; 
i  :  Integer; 

begin 
Sum  :=  0; 

for  i  :=  1  to  4  do 
begin 

Sum  :=  Sum  +  (Neighbors [i]^.SH1SumAirp/10)  *  W[i3 
end; 


Cell [icell] .SNRJS  :=  Round(  (Sum  -  (Noise/10))  *  8  ); 

if  Cell  [icell]  .SNR_S  >  SNRJIHRESHOLD  then 
Cell [ icell ].SNR_S  :=  SNR_'IHRESKDLD; 

if  Cell [ icell ].SNR_S  <  -SNR_'IHRESHOID  then 
Cell C icell ].SNR_S  :=  -SNRJIHRESHOID; 

(*  put  the  vpper  njtble  of  the  MllMR  into  the  vpper  nybble  of  the  *) 

(*  short  path  SNR  *) 

Cell  C  icell  ].SNR_S  :=  Pack_SNR(  (  (MIIMR  AND  $F0)  SHR  4) ,  Cell  [icell]  .SNR_S)  ; 
end; 
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^■****,***Jc***********ik****'*************-*3lt*******.**!(t******5k5fc,********_****jlt^V. 


*  -  *••** 

*  EROGRAM  NAME  -  Omega  Performance  Assessment  * 

*  and  * 

*  Coverage  EvaluatdLon  * 

*  (PACE)  * 

*  Wbrkstation  * 

*  * 

*  UNIT  NAME  -  Part  of  the  RBCXX^V2  Program  * 

*  * 
*************iir***'***!St***X'>it»5*****************ilr*************************** 

*  * 

*  Ihis -program' ■was'vpr^jared' by-  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  ■' 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  develqped  to  run  on  a  IBM  PC/AT  or  coirpatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main  * 

*  meirory  and  an  EGA  or  ccnpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  > 

*  DiaG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Onega  Navigation  System  Center  (CSNSCEN) ,  Alexardria,  VA.  * 

*  * 

*•*******■******■**■****■********************'*********'*********************** 

*  * 

*  PURPOSE  * 

*  This  file  contains  the  code  necessary  to  compute  the  path  * 

*  /terminator  crossing  angle.  * 

*  * 

*  * 


****'**'**•***■****'**•************■******■***■****'*'*■*■**•*•******•******•********■****  I 


procedure  CaiputeX_Angle(  The_Cell  :  Cell_De&i_Ptr; 

var  Cell  :  CovCells; 

iCell, 

StationNum, 

Month, 

Hour  :  integer  ) ; 

{ 

*******'**'***■*■**'****************************■**•**•************************■* 


*  * 

*  PURPOSE  * 

*  Corputes  the  path/teimdnator  crossing  angle  for  the  cell  * 

*  center  for  the  time  of  interest.  * 


***************************  •***********-**'*********-*******-****ilr****x****'**'**xx 

} 

{ 


B-48 


File  Name:  X  ANGLE. PAS 


$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$,$$,$$$$$$$$$$$$$$ 
ver  0  11/90  MAustvold 

ver  1  11/90  EMAustvold  added  1  line  of  exude  to  do  exunversion 

of  the  latitude  to  geocentric  coordinates 

This  procedure  ccarputes  the  angle  between  the  bearing  of  the  signal 
which  passes  throu^  the  cell  and  the  day/night  terminator.  Hie  internal 
procedure  TIME  provides-  the  necessary  vectors  to  catpite-  the  day/nii^t 
terminator. 

Algorithms'  courtesy  of  PHtorris.  Aren't  they  wonderful? 


$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 

) 

type 

StationVec  =  array[l. .11,1. .3]  of  real; 

SunVeCiype  =  Record 

51  :  real; 

52  ;  Arrayri..20]  of  real; 

53  :  Array[1..20]  of  real; 
end; 

const 

DegreesPerRadian  =  57.29578; 


StationUnitVectors  is  the  unit  vectors  of  all  stations. 

*) 

StationUnitVectors  :  StationVec  = 


(( 

0.9155132  , 

0.3917598  , 

0.09143179) , 

( 

0.1091006  , 

0.9768618  , 

-0.1839513  ), 

( 

0.3628323  , 

-0.8629653  , 

-0.3516303  ), 

( 

0.7214421  , 

-0.100388  , 

-0.6851595  ), 

( 

-0.3558544  , 

0.5321513  , 

0.7682336  ), 

( 

-0.6802296  , 

0.3075657  , 

-0.6653505  ), 

( 

-0.6196952  , 

-0.6577405  , 

0.4282004  ), 

( 

0.5654711  , 

-0.5241008  , 

0.6368367  ), 

( 

0.68521564, 

0.18745213, 

-0.70380482) , 

( 

0.18445728, 

0.46688533, 

-0.86486624), 

( 

0.0  , 

0.0  , 

0.0  )); 
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var 
i 

SimVector 

CoSXAng, 

SinXAng, 

Co^Itansmitter, 

ODsReceiver, 

CosDieta-, 

SirtEhi^  :  real; 


:  Integer; 

:  SunVedIVpe; 


TJR_CrossPra3uQt, 

Reeeiveryector ;  :  arr?iy  [lv.3]-,of  r^ij 


(*****************<[*******************************************************) 


procedure  time( 


Year , Month,  Day , Hour, Minute: 
Var  SunVector  :  SunVediype) ; 


Integer; 


{ 

ifk'iciii(**-kii*ifk*iftfk-ifk**-k-k-k**'k*****ifk***^t*it**ifk*ifk*it*****************-kit*itit** 


*  * 

*  HJRPOSE  * 

*  Utility  routine  that  calculates  the  sun  vector  for  a  given  * 

*  set  of  iiput  conditions.  * 

*************'*************iik*******************************************'** 


) 

const 

NumDaysInYear  = 

SecondsInFullDay  = 
MinutesIhFullDay  = 
Factorl:real  = 

Factor2:real  = 

Factor!: real  = 

Factor4:real  = 

Factor5:real  = 

Factor6:real  = 

Factor?: real  = 

Factors :real  = 


365; 

86400; 

1440; 

0.017202791; 

4.8821549; 

0.01720197; 

6.2367035; 

0.03344403; 

0.00034955625; 

0.91745322; 

0.39784368; 


{* 

NCTTE:  In  this  Iccal  procedure  pay  particular  attention  to  the  conversion 
between  reals  and  integers! !!!!!!  1 1 !  1 !  1 !  1  VERY  IMPORTANT! ! ! ! 


var 
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yearsSince68, 

DaysSince68, 

i  :  integer; 

NEN, 

NumSecx3ndsInDay, 

SUNTL, 

SunLon, 

SSPVC2, 

Past, 

EquationOfTime , 

Ri(^tAscension, 

m-, 

ElevationAngle, 

GMT, 

TimeofDay  :  real; 

begin 

YearsSince68  :=  Year  -  68; 

DaysSince68  ;= 

(NumDaysInYear  *  YearsSince68)  +  ((YearsSince68+3)  DIV  4)  + 
(  ((YearsSince68+4)  DIV  4)-((YearsSince68+3)  DIV  4)  -  3  )  * 
((ItonthfS)  DIV  12)  +  31  *  (Month-1) -( (MontW-V)  DIV  12)- 
((MonthfS)  DIV  12)-((Month+2)  DIV  12)- 
(Month  DIV  12)  +  Day  -  1; 


(* 

AS  PER  IHE  ABOVE  NOTE,  CONVERSION  BETWEEN  INTEGERS  AND  REALS  IS 
EXTREMELY  IMPORTANT  IN  THE  NEXT  LINE  OF  CODE! ! ! ! ! 


NuraSecordsinDay  Minute*60.0  +  Hour*3600,0; 

TimeofDay  :=  DaysSince68  +  NuraSecondsinDay/SecondsInFullDay; 

GMT  :=  TimeofDay  -  DaysSinceSS; 

ElevationAngle  ;=  TimeofDay  *  Factorl  +  Factor2; 

NEN  :=  trunc (ElevationAngle  /  (2*pi)); 

ElevationAngle  ;=  ElevationAngle  -  NEN*(2*pi) ; 

EM  :=  TimeofDay  *  Factor3  +  Factor4; 

SUNTL  ;=  ElevationAngle  +  E^ctorS  *  sin  (EM)  +  Factors  *  sin(2*EM) ; 

{  RightAscension  :=  arccan2  (Factor7*sin  (SUNTL) ,  cos  (SUNTL) ) ; } 

RichtAscension  ;=  arctan (Factor7*sin (SUNTL) /cos  (SUNTL) ) ; 
if  (cos (SUNTL)  <  0.0)  then 
Rii^tAscension  ;=  RightAscansion  +  pi; 
if  (Ri^tAscension  <  0.0)  then 
RightAscension  :=  Ri(^t.Ascension  +  (2*pi) ; 
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Eguabion0frime>?*:=-  El'evationAnglef-  Ri^tAsdension;; 

Sunlon-  ;=  pi  *  (1  -  (2*00?)'')  -  Et^tionOfTiihe;- 
SunVector.Sl  :=  Factors  *  sin  (SUNIL) ; 

SSPVC2  :=  sqrt(l  -  (SunVector.Sl)*(SunVector.Sl) ) ; 

{  todc  out  the  loop  caiase  we  only  use  the  first  result  anyway 
for  i  ;=  1  to  20  do 
begin 

HI  :=  6  *  (i-1) ; 

Past  :=  SunLon  +  2*pi*RI/MinutesInFullDay; 

) 

Past  :=  SunLon; 

SunVector.S2[l]  ;=  SSPV’C2  *  cos  (Past); 

SunVeGtor.S3[l]  :=  SSPVC2  *  sin(P^) ; 


{ 

end; 

) 

end; 


(**********:fc*****************************iilr*******************************J 

begin 

tiine(  90  (*year*) , Month,  15  (*Day*)  ,Hour,  0  (*Minute*)  ,SunVector) ; 

(*  conversion  of  the  latitude  to  Geocentric  coordinates  *) 

{  'Ihe_Cell^.LatCenterInRadians  arctan2 (0.99330562  * 

sin(The_Cell^.LatCenterInRadians)  ,cos('Ihe_Cell^.LatCenterIriRadians) ) ; ) 

'Ihe_Cell^.LatCenterIriRadians  ;=  arctan(0. 99330562  * 

sin  (lhe_ceil^ .  LatCenterInRadians)  /cos  (IhejCell^ .  LatCenterlnPadians) ) ; 

ReceiverVector [  1]  ;  =  sin  ('Ihe_Cell ' .  LatCenterInRadians)  ; 

ReceiverVector[2]  :=  cos(Ihe_Cell''.IatCenterIriRadians)  * 

cos(ThejCell''.IonCenberInRadians) ; 

ReceiverVector [3]  :=  cos ('Ihe_Cell''. LatCenterInRadians)  * 

sin  ('Ihe_Cell'' .  LonCenterInRadians) ; 

Cosiheta  ;=  (StationUnitVectors[StationNum,l]  *  ReceiverVector  [1])  + 
(StationUnitVectors[StationNum,2]  *  ReceiverVector[2])  + 
(StationUnitVectors [ StationNum, 3 ]  *  ReceiverVector [ 3 ] ) ; 

Simheta  ;=  sqrt(l-CosIheta*CosIheta) ; 

TJ\_CrossPrcduct[l]  ;=  (StationUnitVectors [StationNum, 2]  *  ReceiverVeccor[33) 

(StationUnitVectors[StationNum,33  *  ReceiverVector[23) ; 

TJ^_Cn3ssProduct[23  :=  (StationUnitVectors  [StationNum,  3 3  *  ReceiverVector[13 ) 
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(StatioritInitVectors  [ StationNum,  1  ]  *•  PeceiverVector  [  3  ] ) ; 

T_RjCrDSsPrx3duct[3]  :=  (StatioriCMitVectors[StationNum,l]  *  ReceiverVector[2])  - 

(StationlMitVectors[StationNum,2]  *  ReceivexVector[l])  ; 

{  tcxik  the  follcwing  out  trying  to  match  PEM's  algorithm 
GRD  11/19/90 

for  i  :=  1  to  3  do 

T_R_CrossProduct[i]  :=  TJR_Crr>ssProduct[i]  /  Siniheta; 

) 

{  added',/  sintheta  to  the  follcwing  sum  to  match  PEM's  algorithm  } 

CosXAng  :=  ( (T_RjCrossProducb[l]  *  SunVector.Sl  )  + 

(TJR_CrossProduct[2]  *  SunVector.S2[l])  + 

(T_R_CrossProduct[3]  *  SunVector.S3[l])  )  /  Sirtiheta; 

SinXAng  ;=  sqrt(l  -  CosXAng*CosXAng) ; 

CosTransmitter  (StationUnitVectors[StationNum,l]  *  SunVector.Sl)  + 

(StationUnitVectors [StationNum,  2]  *  SunVector.S2[l])  + 
(StatioriLftiitVectors [StationNum,  3]  *  SunVector.S3[l]) ; 

CosReceiver  ;=  (ReceiverVector[l]  *  SunVector.Sl)  + 

(ReceiverVector[2]  *  SunVector.S2[l])  + 

(ReceiverVector[3]  *  SunVector.S3[l]) ; 

if  ((CosTransmitter  *  CosReceiver)  >  0)  then 
Cell[icell].X_Ang  :=  90 
else 

{  Cell[icell] .X_Ang  ;= 

rDund(DegreesPerRadian  *  arctan2  (abs (SinXAng)  ,abs(CosXAng) )); } 

Cell[icell] .X_Ang  := 

round  (DegreesPerRadian  *  arctan  (abs  (SinXAng) /abs  (CosXAng) )) ; 

(* 

if  icell=263  then  begin 

writeln(flcg,  'sirccang  =  ',sinxang,  ’  cosxang  =  ',cosxang, '  arctan  = 
arctan (abs (SinXAng) /abs (CosXAng)),'  xang  =  ',cell[icell].x_ang) ; 
writeln(flcg, 'sunvectors  are  ;  ',sunvector.sl, '  ',sunvector.s2[l] , '  ',sunvector.s3[l 
end; 

*) 

end; 
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This  appendix  contains  the  Pascal  code  listings  for  the  four-month  database  delivery  preparation 
program.  A  discussion  of  this  program  is  provided  in  Section  5.2. 
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File  Nctme;  SELITDB.SRC 


Ihe?SPIEJnDB=-prGg]^*^'iasG|B,-''the'~foliGwdT^ 
program- files'  as- •well  as-  cjther-  PAGE  units:- 

SPLITDB.PAS 


C-2 


File  Name:  SPLTTDB.PAS 


{*********************************************************************** 


*  * 

*  FKX]RAM  NAME  -  Onega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaltiation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME-  -  SPIIlTDB^Prograin  * 

*  * 

*  * 

*  lliis  program  was  prepared  by  * 

*  * 

*  Ihe  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading/  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  conpatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main  * 

■f!  memory  and  an  EGA  or  conpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Cmega  Navigation  System  Center  (ONSCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  PURPOSE  * 


*  This  program  splits  the  four-month  database  files  (one  each* 

*  for  10.2  and  13.6  kHz)  into  equal  halves  so  that  they  can  * 

*  fit  on  1.2  MEyte  delivery  flcppies  (4  total) .  This  program  * 

*  is  as  part  of  the  PACE  delivery  preparation  process.  * 

************************************************************************ j 

Program  break_4m_db_in_half; 

USES  DOS; 

CONST 

Blocksize  =  10240; 

VAR 

i,size:  longint; 

Fin,Ffirsthalf /Fsecondhalf:  file; 
outl,out2:  string; 

Dir:  dirstr; 

Name;  Naroestr; 

Ext:  Extstr; 

Buffer:array[l.  .bloc5<size]  of  byte; 
begin 
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IF/EaEa»eount^“l  THSIr 
begin 

Assign  (Fin,  Pa3:amstr{l) )  ; 

Reset  (Fin,  1)  ; 

size  :=  filesi2e(Fin) ; 

Close  (Fin) ; 

Fsplit(Paraiiistr(l) ,  Dir, Name, Ext) ; 

Assign  (FFirstlialf ,  Dir+Namef ' .  m  • ) ; 

Assign  (FSecondhalf ,  Dir+Namef ' .  222  * ) ; 

Reset  (Fin,  1) ; 

Rewrite (FFirstHalf,!) ; 

Rewrite  (FSecxandHalf ,  1) ; 

POR-i  :=  1  TO' round'(size/blocksize/2)  DO 
begin 

blocJcread  (Fin,  Buffer, blocksize) ; 
bloc3<write(FFirstHalf,buffer,blocksize) ; 
end; 

FOR  i  ;=  round (si2e/blocksi2e/2)+l  TO  trunc(size/blocksize)  CO 
begin 

blockread  (Fin,  Buffer, blocksize) ; 
blockwrite(FSecondHalf, buffer, blocksize) ; 
end; 

for  i  ;=  1  to  round(size  ~  blocksize*trunc(size/blockEize) )  DO 
begin 

bloc3aead (Fin, Buffer,!) ; 
blockwrite  (FSecxjndHalf , buffer,  1) ; 
end; 

Close  (Fin) ; 

Close  (FFirstHalf) ; 

Close  (ESecondHalf) ; 
end 
ELSE 
begin 

writeln; 

writeln( 'Usage:  splitdb  infile'); 
end; 
end. 
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This  appendix  contains  the  Pascal  code  listings  for  die  PACE  installation  program.  A  discussion 
of  this  program  is  provided  in  Section  5.7. 
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File  Name:  INSTALL. SRC 


ffifeblNSIS^hprbgr^’Us^^^th  follqw^ngwsotu^' . 
prograni  ■  flies'  asr  ■well  as  "oth^  ■-PASS^"'uriits:' 

INSTALL.  PAS 
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{*********************************************************************** 
*  * 

*  IRDGRAM  NAME  -  Onega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME  -  INSTALL  Program  * 

*  * 

************************************************************************ 
*  * 

*  This  program  was  prepared  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  ★ 

*  PACE  has  been  developed  to  run  on  a  IM  PC/AT  or  caipatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  caipatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  Dr0323-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (CXCCEN) ,  Alexandria,  VA.  * 

*  * 

*  * 

*  FURPOSE  * 

*  Perform  the  installation  and  setip  of  the  PACE  workstation  * 

*  code  on  the  user's  machine.  Includes  initiating  the  * 

*  four-month  to  12-inonth  database  conversion  program.  * 

*  * 

************************************************************************ j 

{$M  4096,0,16384} 
program  Install; 

uses  dos,crt; 

const 

PacelnitFileName  =  'INITPACE.TXT'; 

ENTER  =  13 ; 

ESC  =  27 7 

FOl  =  59+127; 

F02  =  6CH-127; 

F03  =  61+127; 

F04  =  62+127; 

F05  =  63+127; 

F06  =  64+127; 

F07  =  65+127; 
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F08='  ==-66+12.Zr 

Fd9'-  =^-674^127; 

FIO  =  68+127; 


PacePathTabel 

AmdiivePathLabel 

Ten|X3raryAn*ivePathIabel 

QrPathLabel 

Wfei^tsPathLabel 

CovDBPathlalS^' 

H^pPathTflbel 

QuitLabeL. 

Pac^ivelabel , 

ArchiveDrivelabel 

QrPriveLabel 

Wei^tsDriveLabel 

CovDBDrivelabel 

HelpDrivelabel 

ContinueLabel 


=  'Pace  Path  ;  • 

-  'Archive  Path  :  ' 

=  'Tenporsjry  Archive  Path  :  ' 

=  'Qr  Path  :  ' 

=  'Wei^ts  Path  :  ' 

=  'Coverage}  Database'  Path-  :  ' 

=  'Help  I^th  :  ' 

=  'Quit-  ' 

^-'Pee^  EfcLve-  -:  ' 

=  'Archive  Drive  :  ' 

=  'Qr  Drive  :  ' 

=  'Wei^ts  Drive  :  ' 

=  'Coverage  Database  Drive  :  ' 

=  'Help  Drive  :  ' 

=  '  Continue  Installation  ' 


DefaultPaceDrive 

DefaultPaceDirectory 

DefaultArchiveDrive 

DefaultArchiveDirectory 

DefaultQrDrive 

DefaultQrDirectory 

DefaultWei^tsDrive 

DefaultVfeigntsDirectory 

DefaultCovDBDrive 

DefaultCovDBDirectory 

DefaultHelpDrive 

DefaultHelpDirectory 


in*  i  ♦ 

=  '\PACE'; 

=  DefaxiLtPaceDrive; 
=  '\ARCHIVE'; 

=  D^aultPaceDrive; 
=  '\QR'; 

=  DefaultPaceDrive; 
=  '\WEIGHTS'; 

=  DefaultPaceDrive; 
=  'XCOVDB'; 

=  DefaultPaceDrive; 

=  '\HEIP'; 


var 

trtpDrive, 

tnpDirectory, 

PaceDrive, 

PaceDirectory, 
ArchiveDrive, 
ArchiveDirectory, 
TeriporaryArchiveDrive , 
TenporaryArchiveDirectory , 
QrDrive, 

QrDirectory, 

Wei^tsDrive, 

Wei^tsDirectory, 

CovDBDrive, 
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Co\^BDirectory, 

HelpDrive, 

HelpDirectory 

:  string; 

k^ 

continue, 

:  char; 

done 

:  boolean; 

NewPacePath 

:  strirg;  (*PathStr;  *) 

dir 

:  DirStr; 

name 

:  NameStr; 

ext 

:  ExtStr; 

keyvalxie, 

number, 

i 

:  integer; 

(***************************************************************************) 

procedure  GetKeyInput  (var  key:  char) ; 

{ 

************************************************************************ 


*  * 

*  HJRPOSE  * 

*  Retrieves  user  key  iiput  for  the  installation  selections.  * 

*  * 


************************************************************************ 

} 

begin 

reseat 

until  keypressed; 
key  :=  readkey; 

if  key  =  vO  then 
begin 

(*  special  key  has  been  pressed,  must  read  secordaiy  code  *) 
key  :=  chr(ord(ReadKey)  +  127) ; 
end; 
end; 

^***************************************************************************'j 

procedure  TestKeyInput(var  k  :  char) ; 

{ 


*  * 

*  HJRPOSE  * 

*  Utility  routine  to  double  check  user's  intention.  * 

*  * 


) 

begin 
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writein(c'  Isc.this.^CorreGt?/)’?. 
writeln; 

writeln('  <y> .  OMINUE  '); 

writeln('  <N> . TRY  AGAIN  '): 

writeln('  <ESO  or  <Q>  ...  (?IET  '); 

writeln; 

r^jeat 

vmtil  teypressed; 
k  ;=  readkey; 
end; 


(*****************************************,**********************************) 


procedure-WriteHaadar; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Utility  routine  to  display  the  PACE  initialization  header.  * 

*  * 


} 


begin 

te>±backgrciund(blue) ; 
te>ctcolor(vhite) ; 
clrscr; 

writeln  ('***  PACE  INSTAIIATION  ***'); 
writeln; 
end; 


(***************************************************************************) 

procedure  V?rit^^ainScreen; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Utility  routine  to  display  the  PACE  initialization  menu.  * 

*  * 


} 


begin 

writeln ('Select  an  Option  (FI  ~  FIO)'); 

writeln(") ; 

writeln; 

writeln  ( '  /////////////////////////////////////////////////////////////// ' )  ; 
write('  ');  textcolor (black) ;  textbackground(cyan) ;  writs('Fl'); 
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textcolor(vMte)  ;text±>adcground(blue) ; 
write('  '); 

write  ('  Modi^  '+PacePathLabel) ; 
ta’ctcx)lor(yellcw)  ; 
wrJ.teln  (PacePrivef PacePirectory) ; 
tey.tcolor(vMte)  ;textbackgrcund(blue) ; 

write('  ');  textcolor (black) ;  textbackgrT3ur)d(cyan) ;  write{'F2')  ; 
textcolor(vMte)  ;textbad{ground(blue) ; 
write('  '); 

write  ('  Modify  '+ArchivePathLabel)  ; 
textcolor  (yellow) ; 

writeln(ArdiiveDrivefArchiveDirectory) ; 
textcolor  (white)  ;textbadkground(blue) ; 

write('  *);  textcolor  (black) ;  text±3ackground(cyan) ;  write('F3') /* 

textcolor  (white)  ;textbackground(blue) ; 

write(' 

write  ('  Modify  '+QrPathLabel) ; 
textcolor  (yellow) ; 
writeln(QrDrive+QrDirectory) ; 
textcolor  (white)  ;textbackgrDund(blue) ; 

write  ('  ');  textcolor  (black) ;  textbackground  ( c^^) ;  write  ( '  F4 ' ) ; 

textcolor  (white)  /textbackground  (blue) ; 

write(' 

write  ('  Modify  '+Wei^tsPathLabel) ; 
textcolor  (yellow) ; 

writeln(WeightsDrive+WeichtsDirectory)  7 
textcolor  (vMte)  /textbackground  (blue)  / 

write  ('  ')/  textcolor  (black)  /  textbackground  (cyan)  /  write('F5')/ 
textcolor  (white)  /textbackground  (blue)  / 
write('  ')/ 

write  ('  Modi^  '+CovDBPathLabel)  / 
textcolor  (yellow)  / 
writeln(CovDBDrive+CovDBDirectory)  / 

textcolor  (vMte)  /textbackground  (blue)  / 

write  ' )  /  textcolor  (black)  /  textbackground  (cyan)  /  write  ( ' F6 ' )  / 
textcolor  (vMte)  /textbackground  (blue)  / 
write('  ')/ 

write  ('  Modify  '+HelpPathIabel)  / 
textcolor  (yellow)  / 
writeln(HelpDrivefHelpDirectory)  / 

textcolor  (vtdte)  /textbac]^round(blue)  / 
writeln/ 

write ('  ')/  textcolor (black) /  textbackground (cyan) /  write ('F9')/ 
textcolor  (vMte)  /textbackground  (blue)  / 
write('  ')/ 

write  ( Continuelabel )  /  writeln  / 
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');  text6oior.(blae)c)4  teaictBadogfeu^Ccyan) ;  wbiteXi'FlO^)':; 
textcolor(vMte)  ;textl»ckgrciijnl(blvie)  ; 
write(' 

write  (QuitLabel) ;  writeln; 

///////////////////////////////////////////////////////////////•)'. 

end; 


^  ******************************************************************************  j 


procedure  Cb^tngePath(DriveIabelvPathLabelv Drive, Directory  :  string); 

{ 

************************************************************************ 
*  (  * 
R3RE0SE!*  * 

*  Utility  routine  to  change  the  path  that  the  PACE  executable* 

*  will  reside  in.  * 

************************************************************************ 

) 


var 

alldone  ;  boolean; 


begin 

repeat 

alldone  :=  true; 
clrscr; 

WriteHeader; 

writeln; 

writeln  (PathLabel+Drive+Directory) ; 
writeln; 

write( 'Enter  New  Drive  and  Path  :  ') ; 

readln(NewPacePath) ; 

writeln; 

for  i  :=  1  to  length (NewPacePath)  do 
NewPacePath[i]  ;=  V5x:ase(NewPacePath[i3) ; 
fsplit (NewPacePath,  dir , name,  ext) ; 
tnpDrive  ;=  copy  (dir,  1,2) ; 
trpDirectory  :=  "; 
if  (tnpDrive  o  ")  then 
begin 

tupDirectory  :=  copy  (dir,  3,  length  (dir)  )+naine  +  ext; 
writeln  ('New  '  +  DriveLabel+  trtpDrive)  ; 
writeln  ('New  '  +  Pathlabel  +  tnpDirectory) ; 
end 
else 
begin 

textbac3<grcund(red) ; 
textcolor  (white) ; 
writeln; 
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writeln(' Incorrect  Drive-Selected...  Please  Try  Again') ; 
writeln; 

textcolor  (white)  ;text±?ac]<grciurid{blue) ; 
alldone  :=  false; 
end; 

writeln; 

writeln  ('Press  any  key  to  continue. . . ') ; 

GetKeylrpit(key) ; 
if  (ord(key)  =  ESC)  then 
alldone-  :=  true; 
xmtil  alldone; 
end; 


(^**********it**it*ii**ik********it**************itic******ic-k**'k********************'j 


procedure  CreateDirectory(dirpath:  string) ; 

{ 

************************************************************************* 


*  * 

*  HJRPOSE  * 

*  Utility  routine  to  create  the  necessary  individual  * 

*  directories.  * 


*************************************************************************** 

} 

var 

dirinfo  :  searchrec; 
tenp  :  string; 

NumSubDirectories , 
count, 

i, 

SubDirCount  :  integer; 


begin 

tenp  ;=  dirpath; 
i  ;=  0; 

NuroSubdirectories  :=  0; 

for  i  ;=  1  to  length  (dirpath)  do 

begin 

tenp[i]  :=  '  '; 
if  dirpathCi]  =  '\'  then 
inc(Nun!Subdirectories) ; 

end; 


for  SubDirCount  :=  2  to  NunSubDirectories+l  do 
begin 

count  :=  0; 
i  :=  0; 

while  (i  <  length  (dirpath) )  and  (count  o  SubDirCount)  do 
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begin 
inc(i)  ; 

teiEp[i3  :=  dirpath[i] ; 
if  dirpath[i+l]  =  'y  then 
inc((X)imtt) ; 

end; 

f indf  irst  (teaup ,  Directory ,  dirinf o) ; 
if  (DosError  =  3)  or  (DosError  =  18)  then 
inkdir(teirp) ; 

end; 

end; 


procedure  Ma3ceDirectories; 

{ 

************************************************************************ 


*  * 

*  HJRPOSE  * 

*  Utility  routine  to  create  the  selected  PACE  directory  * 

*  structure.  * 


************************************************************************ 

) 

var 

dirinfo  :  searchrec; 
begin 

findfirst(PaceDrive+-PaceDirectori^  Directory,  dirinfo) ; 
if  (DosError  =  3)  or  (DosError  =  18)  then 
createDirectory(PaceDrivefPaceDirectory) ; 


f  indf  irst  ( ArchiveErivef ArchiveDirectory ,  Directory ,  dirinfo) ; 
if  (DosError  =  3)  or  (DosError  =  18)  then 
createDirectory(ArchiveDrivefArchiveDirectory) ; 

findfirst(QrDriveKDrDirectory,  Directory, dirinfo) ; 
if  (DosError  =  3)  or  (DosError  =  18)  then 
createDirectory(QrDrive+<2rDirectory) ; 


findfirst(Wei^tsDrivefWei(^tsDirectory, Directory, dirinfo) ; 
if  (DosError  =  3)  or  (DosError  =  18)  then 
createDirectoryfWeightsDrivefWeightsDirectory) ; 

findfirst(CovDBDriv6H<tovDEDirectory, Directory, dirinfo) ; 
if  (DosError  =  3)  or  (DosError  =  18)  then 
createDirectory(Cin;DEIlrive+CovDBDirectory) ; 

f  indf  irst  (HelpDrive+HelpDirectory ,  Directory ,  dirinfo) ; 
if  (DosError  =  3)  or  (DosError  =  18)  then 
createDirectory  (HelpDrive+HelpDirectory) ; 
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end; 


(*********■***■***************************************************************  j 


procedure  CheckAvailableDiskSpace; 

{ 

************************************************************************ 


*  * 

*  ropposE'  * 

*  Routine,  to  ensure’  that  there  is  enou^  disk  space  to  * 

*  install  PACE.  Checks  all  proposed  PACE  directories,  * 


************************************************************************ 

) 

CONST 

PaceDriveSize  =  800000; 

ArchiveDriveSize  =  650000; 

QRDriveSize  =  30000; 

Wei^tsDriveSize  =  1000; 

CovDBDriveSize  =  15000000; 

HelpDriveSize  =  90000; 


VAR 

i: integer; 

requiredspace:  array [1.  .26]  of  longint; 

function  drivenum(driveletter:string) : integer; 
begin 

drivenum  :=  ord (upcase (driveletter [l]))-$40; 
end; 


function  drivelet  (drivenuniber;  integer) : string; 
begin 

drivelet  ;=  chr(drivenuiriber+$40)  + 
end; 


begin 

(*  first  mark  all  selected  drives  *) 

FOR  i  ;=  0  to  25  DO 

requiredspace [i]  ;=  0; 

requiredspace  [drivenum  (PaceDrive)  ]  ; = 

requiredspace  [drivenum  (PaceDrive)  ]  +  PaceDriveSize; 
reqairedspace[drivenum(ArciuveDrive)  ]  := 

requiredspace[drivenum(ArchiveDrive)  ]  +  ArchiveDriveSize; 
requiredspace  [  drivenum  ( QRDrive)  ]  ; = 

requiredspace  [  drivenum  (QRDrive)  ]  +  QRDriveSize; 
requiredspace  [  drivenum  (Wei^tsDrive)  ]  ; = 

requiredspace  [ drivenum  (VfeightsDrive)  ]  +  Wei(^tsDriveSize; 
requiredspace  [  drivenum  ( CovDEDrive)  ]  : = 
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re^ai3?edsga<3e[drivenum(C0vDH3rive).3  +  CovDBDjriveSize;*- 
requirea^ceXdfivenum  (HelpDr'ive)'  ]  ;  =  ‘ 

requira3space[cirivenum(HelpDrive)  ]  +  HelpDriveSize; 

(*  check  the  space  on  the  specified  drives  *) 

FOR  i  :=  0  to  25  DO 

IF  requiredspace[i]  >  0  THEN 

IF  (requiredspace[i]  >  diskfree(i) )  THEN 
begin 
clrscr; 
writeln; 

writeln( 'Unable  to  continue  PACE  installation  due  to  insufficient  disk  space') 

writeln ( ' on  Drive  ' , drivelet( i) , ' . ' ) ; 

writeln; 

writeln  ('For  the  selected  configuration,  at  least  ',requiredspace[i] , '  bytes') 
writeln  ('of  free  disk  space  must  be  available  on  Drive  ',drivelet(i) ,'.'); 
writeln; 

writeln  ('Please  free  the  necessary  disk  space  or  reassign  the  drives') ; 
writeln  ('and  rerun  the  PACE  installation  program. ') ; 
halt; 
end; 

end; 


(***************************************************************************) 


(***************************************************************************) 

function  check_disk_label  (ej<pected_label; string) : boolean; 

{ 

************************************************************************ 


*  * 

*  RIRPOSE  * 

*  Utility  to  ensure  that  the  user  has  inserted  the  correct  * 

*  PACE  delivery  diskette.  * 


****'******************************************X************************* 

) 

VAR 

restseardrrec; 

begin 

findfirst  ('*.*' , VolurnelD,  res)  ; 

IF  res. name  =  ejqDected_label  THEN 
check_disk_label  ;=  true 
ELSE 

check_disk_label  :=  false; 

end; 


^  **********************************  ■x*'**'*****x**x***'***x**'**xx***'*x*xx*x:^r*x**x**x'*j 

procedure  CqyFiles; 
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{ 

**★***★***★★★★**★★**★****★**★****★****★******★***********★************** 

*  * 

*  HMOSE  * 

*  Utility  to  copy  the  PACE  files  fron  the  delivery  distettes  * 

*  to  the  user's  hard  disk.  Also  initiates  database  build.  * 
************************************************************************** 

} 

VAR 

correct_disk:boolean; 

begin 

correctjdisk  :=  check_disk_label('PACEl') ; 
while  NOT  correctjdisk  DO 
begin 
clrscr; 

WriteHeader  • 

writeln(' Insert  PACE  Disk  Labeled  :  Disk  1  of  5') ; 
writeln; 

writeln( 'Press  any  key  to  continue. . . ; 

GatKeylnput(key) ; 

correctjdisk  :=  checkjdisk_label('PACEl') ; 
end; 
clrscr; 

WriteHeader; 

writeln; 

writeln  ( 'Copying  PACE  executable  code. . . ' ) ; 
swapvectors; 

exec(Getenv('a31SPEC') , '/C  OOPy  \EXE\*.*  '+PaceDrive+PaceDirectoi.y) ; 
swapvectors; 

writeln; 

writeln  ('Copying  PACE  Reliability  files'); 
swapvectors; 

exec(Getenv('ca^SPEC') , '/c  COPy  \(2R.\*.*  '-K2rDrivefQrDirectory) ; 
swapvectors; 

writeln; 

writeln  ('Copying  PACE  Wei^ts  files'); 
sw^jvectors; 

exec(Getenv('ca5SPEC')  ,'/C  COPy  \WEI(2ns\*.*  '4WeichtsDrivefWei^tsDirectory)  ; 
sw^Tvectors; 

writeln; 

writeln  ('Copying  PACE  Coverage  Database  files') ; 
swapvectors; 

exec(Getenv('CaiSPEC'),'/C  COPY  \0C5VDB\*.*  'tCovDBDrivetCovDBDirectory)  ; 
swapvectors; 
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wEitein;’ 

writelh('Ccpyirjg  PACE  Help  files') ; 
swapvectors; 

exec(Getenv('(XMSPEC'),  VC  OOP!ir  VELP\*.*  '+HelpDrive+HelpDicectory) ; 
swc53vec±ors; 

correctjdisk  :=  FALSE; 
vdiile  NOT  correctjdisk  DO 
begin 
clrscT'; 

WriteHeader; 

wrlteln ( ' Insert  PACE  Disk;  Labeled  :  Disk  2  of  5') ; 
writeln; 

writelh  (• '  Press;  any  key .  to  continuev . . ' ) ; 

GetKeylnput(key) ; 

correctjdisk  :=  cdieckjdisk_label('PACE2') ; 
end; 

writeln ('Ccpying  PACE  Coverage  Database  files') ; 

writeln; 

swc^jvectors; 

exec(Getenv('CCMSPEC') , '/C  COPy  *.*  '4<i3vDBDrive+CavDBDirectory) ; 
swapvectors; 

correctjdisk  :=  FALSE; 
vtnle  NOT  correctjdisk  DO 
begin 
clrscr; 

WriteHeader; 

writeln  ('Insert  PACE  Disk  Labeled  ;  Disk  3  of  5') ; 
writeln; 

writeln( 'Press  any  key  to  continue. . . ') ; 

GetKeyIr?xit(key) ; 

correctjdisk  ;=  checkjdisk_label  ( 'PACE3 ' ) ; 
end; 

writeln ('Ccpying  PACE  Coverage  Database  files') ; 

writeln; 

swc^A^ectors; 

exec(Getenv('a2^SPEC') , '/C  COPY  *.*  '4<rr/DEDriveKtovDBDirectory) ; 
swapvectors; 

correctjdisk  :=  FAL£E; 
vMle  NOT  correctjdisk  DO 
begin 
clrscr; 

WriteHeader; 

writeln  ('Insert  PACE  Disk  labeled  ;  Disk  4  of  5') ; 
writeln; 

writeln ('Press  any  key  to  continue. . . ' ) ; 

GetKey Input  (key) ; 
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c»rrect_disk  :=  check_disk_label('PACE4')  ; 
end; 

writeln('Ctepying  PACE  Cov’-erage  Database  files'); 

writeln; 

sw^^vectors; 

exec(Getenv('CX»BPEC'),  VC  COPY  *.*  '-KtovDBDrivefCovDBDixectory)  ; 
swapvectors; 

correctjdisk  :=  FALSE; 
while  NOT  correctjdisk  DO 
begin 
clrscr; 

WriteHeader; 

writeln  ('Insert  PACE  Disk  Labeled  :  Disk  5  of  5')  ; 
writeln; 

writeln ( 'Press  any  key  to  continue. . . ' ) ; 

GetKieyIr5xrt(key) ; 

correctjdisk  :=  check_disk_label ( 'PACES' )  ; 
end; 

writeln ('Copying  PACE  Coverage  Database  files') ; 

writeln; 

swapvectors; 

exec(Getenv('CCMSPEC'),'/C  COPy  *.*  '4CovDBDrive+CovDEDirectory) ; 
swapvectors; 

clrscr; 

WriteHeader; 

writeln; 

writeln; 

writeln ('Conbining  the  partial  PACE  Coverage  Database  files')  ; 
writeln; 

ChDir(CovDH3rive+CovDBDirectory)  ; 
swapvectors; 

exec(Getenv('a2CEEC') , '/C  COPY  /b  102cavdb.lll  +  102covdb.222  102covdb.4m'); 
exec(Getenv('a2^SPEC'),'/C  DEL  102covdb.lll'); 
exec(Getenv('CC2CPEC') , '/C  DEL  102covdb.222'); 

exec(Getenv('CaiSEEC'),'/C  COPY  /b  136covdb.lll  +  136cavdb.222  136covdb.4iTi'); 
eicec(Getenv('a31SPEC') , '/C  DEL  136covdb.lll'); 
exec(Getenv('a3<KPEC'),'/C  DEL  136covdb.222') ; 
swapvectors; 

clrscr; 

WriteHeader; 

writeln; 

writeln; 

writeln  ('Making  the  PACE  12  nonth  Coverage  Database  files') ; 
writeln("Ihis  process  nay  take  isj  to  one  hour . ')  ; 
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sw^ectors; 
exec('Ma3cel2in.exe', ") ; 

exec(Getenv('CrMSPEC') ,  VC  IMj  102ccivdb.4in') ; 
exec(Getenv('OaCEEC'),  VC  DEL  136cc3vdb.4in')  ? 
sw^Tvectors; 

ChDir(PaceDrivefPaceDirectory) ; 
end; 


(***************************************************************************) 


procedure  CreatelnitFile; 

{ 

**************^****.***********************************'****************** 
*  * 

*  PURPOSE  * 

*  Utility  to  create  the  text  file  that  contains  the  PACE  * 

*  environment  setip  information  used  at  PACE  startxp.  * 

************************************************************************ 

} 

var 

f  :  text; 

{  **********  Main  INSTALL  program  code  ***********  ) 
begin 

assign(f  ,PaceDrivefPaceDirectory+'\'+PaceInitFileName) ; 
rewrite (f) ; 
writeln ( f , PacePrive) ; 
writeln(f,PaceDirectory)  ; 
writeln  ( f ,  ArchiveDrive) ; 
writeln(f  ,ArchiveDirecbory) ; 
writeln ( f , QrPrive) ; 
writeln (f,QrDirector\’) ; 
writeln (f,Wei(^tsDrive) ; 
writeln(f,VteichtsDirectory) ; 
writeln (f,CovDEDrive) ; 
writeln  ( f ,  CovDBDirectory ) ; 
writeln (f,HelpDrive) ; 
writeln  ( f ,  HelpDira:±ory ) ; 
writeln(f,  'DEFAULT.QR')  ; 
writeln(f ,  'DEFAUHT.WST' )  ; 
writeln(f ,  '102COVDB.12M')  ; 
writeln (f,  '136COVDB.12M')  ; 
writeln(fVCCNrEXr.HLP')  ; 
writeln(f,  'HELP.FLS')  ; 
close(f) ; 
end; 


(*  default  gr  file  *) 

(*  defaialt  wei^ts  file  *) 

(*  default  coverage  database  name  *) 

(*  default  coverage  database  name  *) 

(*  associates  a  context  to  a  help  file  *) 
(*  lists  all  help  files  in  order  *) 
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(*************************************************************************** j 


begin 

done  :=  false; 

PaceDrive 

PaceDirectory 

ArciiiveDrive 

ArdiiveDirectory 

QrDrive- 

QrDirectory 

VfeightsDrive 

Wei^tsDirectory 

CovDBDrive 

CovDBDirectory 

HelpDrive 

HelpDirectory 


Def  aultPaceDrive ; 

Def aultiPaceDirectX)ry ; 

Def aultArdiiveDr ive  ; 

PaceDiiectory+Def aultArdiiveDirectory ; 
Def aultQrDrive  ; 

PaceDirectory+Def aultQrDirectory ; 

Def aiiLtWeightsDrive ; 

PaceDirectory+Def  aultWei^tsDirectory  ; 
Def aviltCavDBDrive ; 

PaceDirectory+Def  aultCovDBDirectory ; 
Def aultHelpDrive ; 

PaceDirectory+Def aultHelpDirectory ; 


virile  not  done  do 
begin 

WriteHeader; 

Wr it^lainScreen ; 
GetKeyIr?JUt(key) ; 


if  i:5xase(key)  =  'Q'  then 
keyvalue  :=  ESC 
else  keyvalue  :=  ord(key) ; 


case  (keyvalue)  of 
FOl  ;  begin 

QiangePath  ( PacePrivelabel ,  PacePathlabel ,  PaceDrive ,  PacePirectory ) ; 
if  (ord(key)  o  ESC)  then  begin 
PaceDrive  :=  tnpDrive; 

PacsDirectory  ;=  tnpDirectory; 

ArchiveDrive  ;=  tapDrive; 

ArchiveDirectory  :=  PaceDirectory  +  DefaultArchiveDirectory; 

TenporaryArchiveDrive  ;=  trpDrive; 

TenporaryArchiveDirectory  :=  PaceDirectory  +  DefaultArchiveDirector 
QrDrive  ;=  tnpDrive; 

QrDirectory  :=  PaceDirectory  +  Def  aultQrDirectory; 

Vfei^tsDrive  ;=  tnpDrive; 

Vfei^tsDirectory  :=  PaceDirectory  +  DefaultWei^tsDirectory; 

CovDBDrive  :=  tnpDrive; 

CovDBDirectory  :=  PaceDirectory  +  DefaultCovDBDirectory; 

HelpDrive  ;=  tnpDrive; 

HelpDirectory  ;=  PaceDirectory  +  Def  aultHelpDirectory; 

end; 

done  ;=  false; 
end; 
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F02;-.  :  baginw 

QiangePath  ( ArchiveDrlvelabel ,  ArchivePatfiLabel^  AfciuveEcl'^e ;  AfcMveDirectpry ) 
if  (oi:d(key))  o  ESC  then  begin 
ArchiveDrive  :=  tnpDrive; 

ArchiveDirectory  :=  tupDirectory; 
end; 

done  ;=  false; 
end; 


F03  ;  begin 

QiangePath(QrDrivel£±>el,QrPathIabel,QrDrive'?QrDirectory)  ; 
if  (ord(]cey))  o  ESC  then  beg^ 

QfDtivet  ;=  tnpPcive;. 

QrDirectory.i  :=  ti^pDirectory-; 
end; 

done  :=  false; 
end; 

F04  :  begin 

ChangePath  (Wei^tsDriveLabel ,  Wei^itsPathLabel , 
Wei^tsDrive,Wei^tsDirectory) ; 
if  (ord(key) )  o  ESC  then  begin 
Wei^tsDrive  :=  tnpDrive; 

V?ei^tsDirectori>'  :=  tnpDirectory; 
end; 

done  :=  false; 
end; 

F05  :  begin 

ChangePath  ( CovDBDrivelabel ,  CovDBPathlabel , 
CovDBDrive,CovDBDirectory) ; 
if  (ord(key))  o  ESC  then  begin 
CovDBDrive  :=  titpDrive; 

CovDBDirectory  :=  titpDirecbory; 
end; 

done  ;=  false; 
end; 

F06  ;  begin 

ChangePath  (HelpDrivelabel ,  HelpPathLabel , 
HelpDrive,HelpDirectory) ; 
if  (ord(key) )  o  ESC  then  begin 
HelpDrive  :=  tnpDrive; 

HelpDirectory  ;=  tnpDirectory; 
end; 

done  :=  false; 
end; 

F07  :  begin 
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end; 

F08  ;  begin 

end; 

F09  :  begin 

QieckAvailableDiskSpace ; 
MakeDirectories ; 

OcpyFiles; 

CreatelnitFile ; 
textbackground  (blade) ; 
clrscr; 

writeln('E5d.t  Initialization  Pregram') ; 
done  ;=  true; 
end; 

ESC, 

FlO  :  begin 

textbackground  (black) ; 
clrscr; 

writeln('Exit  Initialization  Program') ; 
done  :=  true; 
end; 

end;  (*  case  *) 
end; 
end. 
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APPENDIX  E 
MARE12M  LISTINGS 


This  appendix  contains  thePascal  code  listings  forthe  four-month  to  12-month  database  conver¬ 
sion  program.  A  discussion  of  this  program  is  provided  in  Section  5.3. 
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File  Name:  MaKE12M.SRC 


I5fegMai^l^''pfC3graii'  us§^ 

prograin  files  as  well  as  otti^  PAGE' units: 

MaKE12M.PAS 
PACE  RB.PAS 


File  Name:  MaKE12M.PAS 


{*********************************************************************** 


*  * 

*  PROGRAM  NAME  -  Omega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evali:iation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME  -  MAKE12M  Program  * 

*  ★ 

************************************************************************ 
*  * 

*  Biis  program-  was  prepared  ty  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  rm  on  a  IBM  PC/AT  or  coipatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  coipatible  grafiiics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  Dr0323-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (OMSCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Biis  program  handles  the  interpolation  of  the  four-month  * 

*  signal  database  to  the  12-month  format.  Both  the  10.2  kHz  * 

*  and  the  13.6  kHz  database  halves  are  interpolated.  * 

*  * 


************************************************************************ j 

PROGRAM  Make_12jnonth_db; 

Uses  Crt,DOS; 

( 

Convert  the  four  month  databases  to  12  month  databases 
ver  0  6/5/90  KAiench 

) 

FUNCncN  Interpolate (  Major,  Minor;  Integer):  Integer; 

{ 

***************************************x******************************** 
*  * 

*  PURPOSE  * 

*  Utility  function  to  perform  1/3-2/3  intarpolauion  of  two  * 
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ir^wt.ve^uesfe 

**#****^*»W»*W******#*'*##**"*****ilhk********iHif**********'**************jfc***-», 

} 

{  Do  the  twc^-thirds/one-third  interpolation  in  integer  math  } 

BEGIN 

Interpolate  :=  (Major  +  Major  +  Minor)  DIV  3; 

END; 

type 

interptype  =  RECORD 

major,  minor;  Byte;  (  indices  for  2/3  and  1/3  weighing  } 

END; 

CONST' 

Twirl  :string[4]  =  'l/“\'/ 

NUM^DBS  =  2; 

inflle:  array [  1,  .NUM_DBS3  of  string[20]  =  (a0200VDB.4M'/13600VDB.4M')  ; 
outfile:  array [  1.  .NUM_DBS]  of  string[20]  =  ('10200VDB.12M' ,  "13600VDB.12M')  ; 

{  pointers  fron  1..12  to  the  1. .4  organization  of  months 
w/  interpolation  wei^ting  indicated  } 

Int^p:  array[1..12]  of  interptype  =  ( 

(major;l;  minor:4),  (major;l;  minor:l),  (majortl;  minor: 2) , 

(major;2;  minor;l) ,  (major;2;  minor:2) ,  (major:2;  minor;3) , 

(major; 3;  minor: 2) ,  (major:3;  minor;3),  (major; 3;  minor; 4) , 

(major: 4;  minor; 3) ,  (major;4;  minor;4) ,  (major:4;  minor;!) ) ; 

{$R'} 

{$I  PACE_RB.PAS  } 

{^} 

VAR 

fin:  file  of  coviorec_4m;  {  File  variables  ) 

foot;  file  of  covioirec_12m; 

inbuffer;  coviorec_4m;  {  data  buffers  } 

outbuffer:  coviorec_12ra; 

iDB,  i,  icell,  imonth,  itiine;  Integer;  {  indices/countars  } 

SNR_Short,  SNR_Long,  iDcde_ljdiffJhi,mode_l_diff_lo  (*Sigma*) ,  Fhasejdev,  X_angle:  arra' 
Dan__Flag;  Byte; 

X,  y;  Integer; 

BEGIN 

FOR  iDB  ;=  1  to  NUM_DES  DO  BEGIN 
{$!-) 

Assign  (fin,  infile  [  iDB] ) ;  Reset  (fin); 

{$!+} 

IF  lOResult  o  0  THEN  BEGIN 

Writeln(chr(7) ,  V//  Error  evening  iiput  DB  file  '’',infile[iDB] , ///'); 

Halt(l) ; 

END; 
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Assign  (fcjufc,  outfile[iDB]) ;  Rewrite  ( foot) ; 

Writeln( 'Processing  DB  file  #  ',iDB, '  .  . 

X  :=  WhereX; 
y  :=  WhereY; 

{  Locp  throu^  the  cells  -  icell  is  sinply  a  counter  for  c3iagnostics  ) 
icell  ;=  0; 

WHUi:  NGT  EOF(fin)  DO  BEGIN 

inc ( icell ) ;  {  actually  counts  stations-. and.  cells  (8*444)  } 

GotciXY(x,y) ;  Write  (Twirl  [  (icell  MDD  4)+l]) ; 

{$1-} 

Read  (fin,  inbuffer) ; 

($1+) 

IF  lOResult  O  0  THEN  BEGIN 

Writeln(chr(7) ,  V//  Error  reading  cell  #  ',((icell“l)  DIV  8)+l, 

'  -  Station  #  ',((icell-l)  MDD  8)+l,'  ///'); 

Writeln(V//  of  DB  file  "',infile[iDB], ///'); 

Halt(l) ; 

END; 

{  Locp  throu^  the  months  moving  or  interpolating  data  ) 

PDR  imonth  ;=  1  to  12  DO  BEGIN 
{  Interpolation  required  ?  } 

IF  interp[imonth]  .major  =  interp[imonth]  .minor  THEN  BEGIN 
FOR  itime  :=  1  to  24  DO  BEGIN 

outbuffer(imonth,  itime]  :=  inbuffer [interp[imonth]  .major,  itime] ; 

END; 

END 

ELSE  BEGIN 

{  We'll  have  to  interpolate  } 

FDR  itilie  ;=  1  to  24  DO  BEGIN 

{  Unload  the  quantities  into  variables  ) 

SNR_Short[l]  ;=  Get_SNR(iTbuffer[interp[imonth]  .major,  itime]  .SNR_S) ; 
SNR_Short[2]  :=  Get_SNR(irlArffer[interp[imonth]  .minor, itime]  .SNR_S)  ; 
SNR_Iong[l]  :=  Get_SNR(infauffer[interp[iinontn] .major,itime]  .SNR_L)  ; 
SNR_Iong[2]  :=  Get_SNR( inbuffer [intarp[imonth]  .minor, itime]  .SNR_L)  ; 
mode_l_diff_hi[l]  ;=  Get_SIGMA( inbuffer [interp[imonth]  .major,  itime]  .SNR_S) 
mode_l_diff_hij;2]  :=  GetjSIQ1A( inbuffer [interp[iiionth]  .minor,  itime]  .SNR_S) 
mcde_l_diff__lo[l]  ;=  Get_SIQ^A(inbuffer[interp[imonth]  .major,  itime]  .SNR_L) 
mode_l_diff_lo[2]  ;=  Get_SIQiA( inbuffer [inte3q)[imonth]  .minor,  itime]  .SNR_L) 
Ehase_Dev[l]  :=  jnbuffer[interp[imonth]  .major,  itime]  .Phase  AND  $7F; 
Phase_Dev[2]  :=  inbufferCinterpCimonth]  .minor, itime] .Phase  AND  $7F; 
Dan_flag  ;=  inbuffer[interp[ijx)nth]  .major, itime]  .Phase  AND  $80; 

X_Angle[l]  :=  inbuffer[interp[imonth]  .major, itime]  .X_Ang; 

X_Angle[2]  ;=  inbuffer[interprimonth]  .manor, itime]  .X_Ang; 

{  New  interpolate  and  '.oad  data  into  cutbuffer  } 
cxitbufferfiroonth, itime]. SNR  S  ;=  Pack  SNR( 
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Interpolate  (nodejjl^i^ff^hd  [il] ,  itxsde^ljdif f^h±[.2‘30.r/ , 
InteEpolate<SNR^Short[r]-j .  SNR2Sh:orfe'[-2] ) )  7  ■ 
ciutbuffer[imonth,itime].SNR_L  :=  Pack_SNR( 

Interpolate (mode_l_dif f_lo [  1] ,  iiiode_l_dif f_lo [2 ] ) , 
Interpolate(SNR_Long[l] ,  SNR_Long[2] ) ) ; 
outbuffer[i2ionth,itiine].Fhase  := 

(Interpolate (Ihase_Dev[13,  Fhase_Dev[2])AND  $7F)  C3R  Dam_Flag; 
outbuffer[imonth,itime].X_Ang  := 

Interpolate  (X_Angle  [  1  ] ,  X_Angle  [  2  ] ) ; 

END;  {FOR  itime} 

END;  {EISE} 

END;  (FOR  imonth} 


{$Ir) 

WriteXfoutv  '  outbuffer) ; 

{$!+) 

IF  lOResult  o  0  THEN  BEGIN 

Writeln(chr(7) ;  V//  Error  WRITING  cell  #  ',((icell-l)  DIV  8)+l, 
'  -  Station  #  ',((icell-l)  MOD  8)+l/  ///'); 

Writeln(7//  of  DB  file  ''7outfile[iDB] ///'); 

Halt(l) ; 

END; 

END;  {WHILE) 

GotoXY(x,y);  Write('  ');  GotoXY(x,y); 

Close (fin) ; 

Close (f out) ; 

exec(Getenv('0CMSPEC')/7C  DEL  '+infile[iDB]) ; 

END;  (FOR  iDB) 

NoSound;  Scund(lOOO) ;  Delay(lOO) ;  Sound(500) ;  Delay(lOO) ;  NoSound; 


END. 
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I *********************************************************************** 

*  * 

*  PRCCKAM  NAME  -  Omega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Wortetation  * 

*  * 

*  UNIT  NAME  “  Part  of  the  KBGX»IV2  and  MAKE12M  Programs  * 

*  * 
************************************************************************** 

*  * 

*  This  program  was  pr^ared  by  * 

*  * 

*  The  Analytic  Scierce  Q^rporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading^  Massachusetts  01867  * 

*  * 

*  PACE  has  been  develqad  to  run  on  a  IBM  PC/AT  or  coipatible  * 

*  under  MS-DCS  3.3  or  hi^er  with  a  ndnimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  compatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DrOG23-89-C~20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Cmega  Navigation  System  Center  (CX^SCEN) ,  Alexandria,  VA.  * 

*  * 
************************************************************************ 

*  * 

*  PURPOSE  * 

*  This  file  contains  utility  routines  and  definitions  for  * 

*  the  PACE  10  by  10  degree  cell  database.  THESE  ROUTINES  ARE  * 

*  DUPKECAIES  OF  THOSE  CONTAINED  IN  THE  DAIAUTIL.PAS  PROGRAM  * 

*  file  —  THEY  ARE  REPEATED  HERE  FOR  DEVELOPMENT  PURPOSES  OF  * 

*  THE  RBO0NV2  AND  MAKE12M  PROGRAMS.  * 

************************************************************************1 

(  ************************************************************************* 
* 

*  PACE  cell  database  Data  Definitions  and  utility  routines 

* 

*  ver  0  05/90  KATench 

*  ver  1  11/90  EMAustvold 

* 

*************************************************************************  1 


TYPE 

{  cell  coverage  information  for  1  sta/roonth/hr} 

CovCell  =  RECORD 
SNR_S;  Integer; 

{  Short-path  SNR  (db*S)  w/  Sigma_S  in  icpermost  nybble  (db*8)  ) 
SNR  L;  Integer; 
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{  Lcoig-path  SNR  (db*8),  w/  nc3thing>  in  i^pprmost.^nyhble.,} 
Riase;- 

{  Rvise  Deviation  with  mode  1  flag  in  top  bit  (OMode  1)  } 
X_Ang:  Byte; 

{  Crossing  Angle  } 

END; 


{  record  for  disk  I/O  -  4  months,  24  hours  of  coverage  information  ) 

{  Disk  file  is  organized  as  8  stations  worth  of  coviorec  for  each  of  444  cells  ) 
coviorec_4m  =  array[l.  .4,1.  .24]=  of  CovCell; 

coviorec_12m  =  arrayfl.  .12,1. .24]  of  CovCell;  {  12  month  version  } 

{  Noise  data  information  for  1  month/hr  ) 

NoiseGell  ='REgORD’ 

Si9na_Ns  Byte;-  {  Noise  standard'  deviation  (db*8)  } 

Noise:  Byte;  {  Noise  value  (db*8)  ) 

END; 


{  record  for  disk  I/O  -  12  months,  24  hours  of  noise  information  } 
{  Disk  file  is  organized  as  444  cells  worth  of  noiseiorec  } 
noiseiorec  =  array[l. .12,1. .24]  of  CovCell; 


{  Routines  to  pack  and  unpack  the  fields  of  CovCell  ) 


FUNCTION  Pack_SNR(Sigma,  SNR: Integer) :  Integer; 

{ 

************************************************************************ 
*  * 


*  HJRPOSE  * 

*  Pack  the  sigma  value  into  top  nibble  of  the  SNR  word  in  the* 

*  cell  format  signal  database.  Ihe  sigma  value  is  actually  * 

*  half  of  the  mode  1  dominance  margin  byte  value  * 

*  as  documented  in  the  PACE  final  report.  Ihe  variable  called* 

*  sigma  is  shifted  left  by  12  bits  and  ORed  into  the  SNR  * 

*  value.  * 

************************************************************************ 

) 

{  Pack  the  sigma  value  into  top  nibble  of  SNR  ) 

BEGIN 

Pack_SNR  :=  ((Sigma (*-12*))  SHL  12)  OR  (  SNR  AND  $FFT) ;  {12  =  1.5*8  db) 

END; 


FUNCTION  Get_SNR(SNR_in:  Integer) :  Integer; 

{ 

******************************************** ****'X*******X**************« 
*  * 

*  PURPOSE  * 

*  Remove  the  Icwer  three  nibbles  of  information  from  a  word  * 
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*  length  variable  with  a  quantity  packed  into  the- i;5per  * 

*  nibble  (the-  i?per  four  bits) .  Sign  extend  ty  filling  in  * 

*  the  V5per  nibble  with  ones  if  the  li^per  bit  of  the  third  * 

*  nibble  (bit  #  12  is  set) . 
************************************************************************ 

) 

{  remove  the  top  nytble  and  sign  extend  to  make  a  full  integer  } 

BEGIN 

SNR_in  :=  SNR_in  AND  $FFF; 

IF  (SNR_in  AND  $800)  o  0  IHEN  {  Need  to  extend  sign  bit  ?  } 

Get_a®  :=  SNR_in  OR  $F000 
ELSE 

Get_SNR  :=  SNR_in; 

END; 

FCJNCnc^I  Get_Sigma(SNR_in:  Integer):  Integer; 

{ 

************************************************************************ 

*  * 

*  PURPOSE  * 

*  Remove  the  value  stored  in  the  nibble  of  a  word  value* 

*  ty  masking  off  the  lower  12  bits  and  then  shifting  the  * 

*  result  right  by  12.  * 

************************************************************************ 

} 

{  Extract  sigma  from  top  n^tole  } 

BEGIN 

Get_Sigma  :=  ((SNR_in  AND  $F000)  SHR  12) (*+12*)  (i.e. ,  1.5*8); 

END; 


APPENDIX  F 
PACE  LISTINGS 


This  appendix  contains  the  Pascal  code  listings  for  the  PACE  workstation  program.  A  discussion 
of  this  program  is  provided  in  Section  5.6. 
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The^  PACE;  program,  vses  the.  following'  'souree^ 
program  files  as  well  as  other  PACE  units: 

CELLOTIL.PAS 

CEUWIN.PAS 

CHECEMEM.PAS 

OraiMAN.PAS 

CONTI. PAS 

OONIRDIS.PAS 

OOVGKID.PAS 

CURSPDKJ.PAS 

DAIAUnL.PAS 

DEFS.PAS 

ERRLDG-.PAS 

HELEMENU.PAS 

I£IAD_DEF.PAS 

IDAD_RB.PAS 

MEMOAREA.PAS 

PACE.  PAS 

PACEINTT.PAS 

PACEXDBJS.PAS 

PRDCS.PAS 

PRDCS2.PAS 

PROCS3.PAS 

SAVEMENU.PAS 

STATBARS.PAS 

TASCLCGO.RAS 

WORin-IAP.PAS 
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Unit  cellutil;  {  10  degree  cell  definition/generation  utility  ) 

j  ************************************************************************ 
*  * 

*  IKDGRM  NAME  -  Qrvega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  workstation  * 

*  * 

*  UNIT  NAME  -  CEUITITL  * 

*  * 

*★******★★*******★★*******★★★**★★★■**★★**★***★****★★**★**********★****★★★ 
*  * 

*  This  program  was  prepared  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  compatible  * 

*  imder  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  catpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Onega  Navigation  System  Center  (C^ISCEN) ,  Alexandria,  VA.  * 

*  * 

**********:^t******;V****************************************************** 
it  ★ 

*  FURPOSE  * 

*  Routines  for  defining  and  intializing  the  444  cell  * 

*  grid.  * 

*  * 
**'****-A'********************************************5t********************) 

Interface 
uses  errlog; 


CONST 

MAXATCMS  =  314; 

digits:  array[0..9]  of  char 


=  ('0^'l^'2^'3^'4^'5^'6^'7^'8^'9') 


TYPE 

mg_atan  =  RECORD 

Range:  Integer; 
SNR_Short:  Integer; 
SNR_Long:  Integer; 
Hiasejdev:  Byte; 
Dcmjfcde:  Byte; 


{  Units  of  10  km  ) 

{  Short-path  SNR  in  dB*10  ) 

(  Long-path  Sl'lR  in  dB*10  } 

{  Phase  deviation  in  cec  } 

{  Number  of  the  dominant  rocde  ) 
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Et©r 

RB_Record  =  RBDORD 

Bearing:  Integer;  {  deg*10  ) 

X_Angle:  Integer;  {  terminator  crossing  angle  in  deg*10  } 

a:  array[l.  .MAXMDCMS]  of  mg_atcm;  {  the  range  atcans  } 

END; 

RB_ptr  =  ^RBJiold; 

RB_Hold  =  EEOORD  {  for  linked  list  storage  in  memory  } 

next;  RB_ptr; 

RB:  RB_ReGord; 

END; 

Cell_ReGord  =•  I^EGORD-  {  For  matrix  (gridded)  data  ) 

SNR_Short:  Integer;  {  short-path  SNR  in  dB*10  ) 

SNR_Long:  Integer;  {  long-path  SNR  in  dB*10  } 

Fhase_dev;  Byte;  {  Phase  deviation  in  cec  } 

DanJMode:  Byte;  {  Number  of  the  Dcminant  mode  } 

X_Angle:  Integer;  {  Crossing  Angle  abs(100*cos(X_ang) )  ) 

Coverage:  Integer;  {  coverage  value  for  cell  ) 

END; 

Cellarray  =  array [1.  .1800]  of  Cell_record; 
cellarrayptr  =  ''Cellarray; 

RB  =  RECORD 

Range:  Integer;  {  in  10  km  steps  ) 

Bearing:  Integer;  {  deg  *  10  } 

END; 

Cell_Defn  =  RECORD 

Latl,  Lat2;  Integer; 

Lonl,  Ion2:  Integer; 
xlate:  array[1..8]  of  RB; 

Weight:  Integer; 

END; 

Cell_defn_ptr  =  ^Cell_defn_hold; 

Cell_defn_hold  =  RECORD 

next:  Call_defn_ptr; 
latl,  lat2;  Integer; 

Lonl,  Lon2:  Integer; 

Range:  Integer; 

Bearing;  Integer; 

XI,  X2:  Integer; 

Yl,  Y2:  Integer; 

Weight:  Integer; 

END; 
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{  structure  for  memory  linked  lists  ) 

{  S,N  extents  in  deg^lO  } 

{  W,E  extents  in  deg^lO  ) 

{  in  10  km  steps  ) 

{  deg  *  10  ) 

{  correspond  to  lonl,  Ion2  } 

{  Correspond  to  latl,  Lat:2  } 

{  wei^t  for  carouting  coverage  } 


{  S,N  extents  in  deg*10  ) 

{  W,E  extents  in  deg*10  ) 

{  range/bearing  of  cell  center  ) 

{  wei0t  for  conputing  cav'erage  } 
{  relative  to  each  transmitter  ) 


File  Name:  CFIIJUnX.PAS 


VAR- 

Cell_Ist  :  Cell_defivj3tr; 

NCells  :  Integer; 

Prc3cedure  InitCellGErid; 


Inplementation 


{$I  loadjdef.pas’} 


Procedure  InitCellGrid; 

{ 

★★★★★★★★★★A******************-*********-********************************** 


*  * 

*  PURPOSE  * 

*  Initiali2e  the  cell  444  cells  with  their  respective  * 

*  latitude/longitude  coordinates  for  each  cell  edge.  * 

*  OiU  latitudes  and  longitudes  are  scaled  by  10  and  given  * 

*  in  degrees.  Ihe  cells  are  stored  in  a  linked  list  pointed  * 

*  to  by  Cell__lst.  * 


************************************************************************ 

) 


VAR 

cellsize 

tiiplst 

i 


:  Integer; 

:  Cell_defn_ptr; 
;  Integer; 


begin 

cellsize  ;=  10; 

Ioad_Cell_Definition (cellsize,  Cell_Ist,  NCells) ; 
tirplst  ;=  Cell„Lst; 
for  i  ;=  1  to  NvCells  do 


begin 

tnplst^.Latl 
tirplst ''.Lonl 
tnplst^.Iat2 
tirplst'' .  lDn2 
tnplst  :=  tnplst''.next; 
end; 
end; 


=  tnplst^.  Iatl*10; 
=  tirplst^.  lDnl*10; 
=  tirplst''.  Lat2*10; 
=  tnplst''.  Ion2*10; 


begin 

{  no  initialization  section  ) 
end. 
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^*'*****************^-*’*'*E*'********.********.******'******^**********^***>*-****:^. 

*  *'!' 

*  PROGRAM  NAME  -  Omega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evalxiation  * 

*  (PACE)  * 

*  Wor)cstation  * 

*  * 

*  UNIT  NAME  -  Part  of  PACEOBJS  unit  * 

*  * 
************************************************************************* 

*  * 

*  This-  program'  was^  prepared,  hy  * 

* 

*  Hie  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IM  PC/AT  or  conpatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  cotpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DrCG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (CWSCEN) ,  Alexandria,  VA.  * 

*  * 
************************************************************************ 

*  * 

*  PURPOSE  * 

*  Routines  for  displaying  and  removing  frcm  the  display  * 

*  the  summary  cell,  detailed  cell,  and  difference  query  * 

*  display  windows.  Also  contains  facilities  for  obtaining  the* 

*  ^rcpriate  information  fran  the  databases  for  display  * 

************************************************************************) 

Function  GetGCOP  ( CellNum ,  Coverage ;  longint ) :  string ; 

{ 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Get  the  GDOP  value  for  the  particular  cell/coverage  * 

*  combination  from  the  GDOP  database.  * 

************************************************************************ 

} 

VAR 

GBOPFile  :  file  of  byte; 
i,GDOPVal,numberoavering  :  byte; 
tarogdcp  :  single; 
s  :  string; 
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begin 

GDOPVal  :=  ReadGdcp(cellniM,cx3verage)  ; 

{  count  the  number  of  stations  covering  the  cell  } 
numbercovering  :=  0; 

FOR  i  :=  0  TO  7  DO 

IF  coverage  AND  ($01  SHL  i)  >  0  THEN 
inc  (numbercavering) ; 

IF  nurabercovering  >=  3  THEN 
begin 

IF  GDOFVal  =  255  THEN 
GetGDOP  :=  '>25' 

ELSE 

begin 

tenpgdcp  :=  GDOPVal/10; 
str(tenpgdop:2:l,s) : 

GetGDOP  :=  s; 
end; 
end 
ELSE 

GetGDOP  ;=  'N/A'; 

end; 


constructor  c:tellPopWindow.Init(InitX,Inity,InitWidth,InitHeight  :  integer; 

InitColor,  InitBorderColor ,  InitTextColor , 
InitHiliteColor,InitSelectedColor:  word; 
InitActionProc :  CellActionProcedure ; 

InitSh wProc :  CellShowProcedure ; 
InitCellColor:word;Initeptr:emeni:5>tr) ; 

{ 

************************************************************************ 


*  * 

*  HJRPOSE  * 

*  Ctoject  initialization  code  for  the  summary  cell  query  * 

*  windcw.  * 


************************************************************************ 

) 

var 

ffion,hr:  integer; 
begin 

menu .  Init  ( InitX ,  InitY ,  InitWidth ,  InitHei^t ,  InitColor , 

InitBorderColor, 2, WindowShadcwWidth-2) ; 

Pac  :=  0; 

Wei^t  ;=  0; 

Month  :=  1; 

Hour  ;=  1; 

eptr  :=  Initeptr; 

xoffset  :=  37; 
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:='  27; 

cellwidth  ;=  10; 

cellhei^t  ;=  10; 

TextColor  ;=  InitTextColor; 

SelectedColor  :=  InitSelectedColor; 

for  non  :=  1  to  12  do 
for  hr  ;=  1  to  24  do  begin 

SubCells[i!on,hr]  .Init(InitX+xoffset+(  (inon-1)  *cellwidth) , 

InitY+yoffset+{  (hrri)  *eellhei^t) , 
cellwidth, cellhei^t,  0,0,  (iton*hr) , 
InitGellColor ,  InitCellColor , 
InitBprderCtolor ,  IiutHiliteColor , 
InitAstionPrbo,  IhitShcwPrcc)^; 

end; 

end; 


(***************************************************************************) 

procedure  CellPcpWindcw.Shcw; 

{ 

************************************************************************* 


*  * 

*  PURPOSE  * 

*  Object  method  for  showing  the  summary  cell  query  window.  * 

*  * 


************************************************************************ 

) 

var 

i,xx:,yy,roDn,hr,xi,yi,tw,th  :  integer; 

CellNumStr,PacStr,WtStr  :  String; 

begin 

Get_CursorXY(xx,yy) ; 

Hide_Cursor; 

Windcw.Show; 
for  mon  :=  1  to  12  do 
for  hr  :=  1  to  24  do 
begin 

IF  eptr^.tonthSelectors[iton]  .selected  AND 
^rtx^.HcurSelectors [hr]  .selected  THEN 
begin 

subcells  [non,  hr]  .aboveColor  ;=  lii^tblue; 
subcells  [mon,  hr]  .belcwcolor  ;=  lightred; 
end 
ELSE 
begin 

subcells  [mon,  hr]  .aboveColor  ;=  blue; 
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subcxlls[mon,hr]  .belcwcsDlor  :=  red; 
end; 

SubCells[man,hr]  .Shew; 
end; 


setcolor(TextColor) ; 

settextstyle  (smallfont ,  horizdir,  4 )  ; 
settextjustij^(lefttext,tcptext)  ; 


th  :=  1:e}Cthei^t('l')+2; 
tw  :=  textwidth('l') ; 
xi  :=  xoffset+text:width('l')-2; 
yi  :=  yoffset-th-1; 

(*  get  the  cell  number  and  display  it  in  the  window  *) 

str(CellNum,CellNumStr) ; 

CellNumStr  :=  'if'  +  CellNuinStr  ; 
outtexbQr(X+5,Y+yi,CellNumStr) ; 

Pac  :=  IlilitedCellPtr^.Pac; 
str(Pac;7;6,PacStr) ; 

PacStr  ;*=  'P  '  +  PacStr; 

if  Pac  <  ^jtr'.Psa. value. value  THEN 
begin 

setfillstyle(solidfill,red) ; 

bar  (x+4 ,  y+3 ,  x+5+textwidth  (PacStr)  +1 ,  y+3+textheight  (PacStr)  +2 ) 
end; 


outtextxy  (X+5 ,  Y+3 ,  PacStr) ; 
outtextxy(X+5+tw,Y+5,  'AC') ; 

Wei^t  :=  HilitedCellPtr^.Wei^t_or_Coverage; 
str(wei^t;l,WtStr) ; 

VTtStr  'Weight  '-WtStr; 

outtexbiy  (X+width~taxtwidrh  (WtStr)  -5 ,  Y+3 ,  wtstr ) ; 

{  write  out  the  month  selections  ) 

outtextxy  (X+xi+  0*tw,Y+yi, 'J') ; 
outtexbQ7(X+xi+  2*tw,y+yi,  'F') ; 
outtexbQ^(X+xi+  4*tw,Y+yi,  'M') ; 
outtextxy (X+xi+  6*tw,Y+yi, 'A') ; 
outtext>Q^(X+xi+  8*tw,Y+yi,  'M') ; 
outtextxy (X+xi+10*t:w,y+yi,  'J') ; 
outtexCQ^  (X+xi+12  *tw,  Y+yi , '  J ' ) ; 
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ogtt|jd^,('X#d-+14*tv^Y+yi 
cuttext2Q^(X-4^xi+16*tw,y+yi,  ; 
cxtttextxy(X+xi+i8*tw,Y+yi,  'o*) ; 
cxittextsQ^  (X+xi+20*tw,  Y+yi ,  'N' ) ; 
cut±extxy(X+xi+22*tw,Y+yi,  'D') ; 

setfillstyle  ( solidf  ill ,  Selectedcolor) ; 

for  i  :=  1  to- 12  do 

IF  ^rtrr''.MdrithSelec±ofs[d]  .select^  a:ES?jrfbar(X-2txi+(i-l)*2^//, 

y+yi> 

X+2+xi+  (i-i)  *2*tw+tw, 
Y+yi+th-1) ; 


setcolor(TextColor) ; 

IF  ^Jtr'.MonthSelectors[  1]. selected  TEffiN  qtittextxy(X+xi+  0*tw,Y+yi, 'J') ; 
IF  q3tr^.MonthSelectors[  2]. selected  THEN  outtext:7’(X+idL+  2*tw,Y+yi/F') ; 
IF  ^jtr^.MonthSelectors[  3]. selected  THEN  outtextxy(X+xi+  4*tw,Y+yi, 'M') ; 
IF  ^Jtr^.MonthSelectors[  4]. selected  IHEN  outtext:Qf(X+xi+  6*tw,Y+yi, 'A')  ; 
IF  ^rtar^.MGnthSelectors[  5]. selected  TEiEN  outtext:jqr(x+xi+  8*tw,Y+yi,  'M') ; 
IF  Q±r'.ltonthSelectors[  6-]. selected  TEEN  outtextoQr(x+xi+10*tw,Y+yi/j') ; 
IF  qrtar^.MonthSelectors[  7]. selected  IHEN  outtextoQr(x+xi+12*tw,Y+yi/J') ; 
IF  ^Jtr^.MonthSelectors[  8]. selected  IHEN  outtexbQr(x+xi+14*tw,Y+yi/A') ; 
IF  ^Jtr'.MonthSelectorsi  9]. selected  IHEN  outtext:Q^(X+xi+16*tw,Y+yi/S') ; 
IF  ^rtx^.ltonthSelectors[  10]. selected  IHEN  outtextxy(X+xi+l8*tw,Y+yi/0')  ; 
IF  ^7tr^.MonthSelectors[  11]. selected  IHEN  outtextxy(X+xi+20*tw,Y+yi/N') ; 
IF  ^3tr^.^fo^thSelectors[  12]  .selected  THEN  outtextxy(X+xi+22*tw,Y+yi,  'd')  ; 

{  new  write  the  hour  choices  } 
tw  ;=  textwidth('ll')+l; 
xi  :=  (xoffset~21)+textwidth('l') ; 
yi  :=  yoffset; 

setcolor(TextCOlor) ; 

outtextxy(X+xi,Y+yi+  0*th,  '01') ; 
outtextxy(X+xi,Y+yi+  l*th,  '02') ; 
outtextxy(X+xi,Y+yi+  2*th, '03'); 
outtextxy(X+xi,Y+yi+  3*th, '04'); 
outtextxy(X+xi,Y+yi+  4*th,  '05') ; 
cuttextxy(X+xi,y+yi+  5*th,  '06') ; 
outtextxy(X-fxi,Y+yi+  6*th,  '07') ; 
outtexbQ^(X+xi,Y+yi+  7*th,  '08') ; 
outtexbQ'  (X+xi ,  Y+yi+  8*th, '  09 ' ) ; 
cuttextxy  (X+xi ,  Y+yi+  9*th, '  10 ' ) ; 
outtextiQ^  (X+xi ,  Y+yi+i0*th , '  11 ' ) ; 
cuttextxy  (X+xi ,  Y+yi+ll*th , '  12 ' ) ; 
cuttextxy  (X+xi,  Y+yi+12*th, '  13 ' )  ; 
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outtext^(X+xi,Y+yi+13*th,  '14') ; 
cuttextxy(X+xi,Y+yi+14*th,  '15') ; 
outtextxy  (X+xi ,  Y+yi+i5*th, '  16 ' )  ; 
outtext»y(X+xi,Y+yi+16*th,  '17')  ; 
outtext3^(X+xi,Y+yi+17*th,  '18')  ; 
outtextxy(X+xi,Y+yi+i8*th,  '19')  ; 
outtext3Q^(X+xi,Y+yi+i9*th,  '20') ; 
cxittextJQ^(X+xi,Y+yi+20*-th,  '21')  ; 
cul±ext2Q^(X+xi,Y+yi+21*th,  '22')  ; 

(xrt±extxy(X+xi,Y+yi+22*th,  '23') ; 
cxrttextxy  (X+xi ,  Y+yi+23*th, '  24 ' ) ; 

setf  illstyle  ( solidf  ill ,  selectedcolor ) ; 
for  i  :=  1  to  24  do 

IF  ^3tr^.HourSelectors[i]  .selected  IHEN  bar(X+xi-2, 

Y+l+yi+ ( i“l ) *th , 
X+xi+tw, 

Y+yi+(i-l)*thfth) ; 


setcolor(TextColor) ; 


IF  qjtr^.HourSelectorsC  1]. selected  IHEN  outtextxy  (X+xi,  Y+yi+  0*th, '01'); 
IF  ^Jtr^.HourSelectors[  2]. selected  THEN  outtextxy  (X+xi,  Y+yi+  l*th, '02') ; 
IF  eptr^.HourSelectors[  3]. selected  THEN  outtexbq^(X+xi,Y+yi+  2*th, '03'); 
IF  eptr^.HourSelectors[  41. selected  THEN  outtextxy  (X+xi,  Y+yi+  3*th, '04'); 
IF  eptr^.HourSelectors[  5]. selected  THEN  outtextxy  (X+xi,  Y+yi+  4*th, '05'); 
IF  q3tr^.HourSelectors[  6]. selected  THEN  outtextxy  (X+xi,  Y+yi+  5*th, '06'); 
IF  ^±r''.HourS€lectors[  7). selected  THEN  outtexby(X+xi,Y+yi+  6*th, '07'); 
IF  eptr'.HourS€lectors[  8]. selected  THEN  outtextoQ^(X+xi,Y+yi+  7*th, '08'); 
IF  eptr'.HourSelectors[  9]  selected  THEN  outtextxy  (X+xi,  Y+yi+  8*th, '09'); 
IF  eptr''.HourSelectors[10]  .selected  IHEN  outtextxy  (X+xi,  Y+yi+  9*th, '10'); 
IF  eptr'‘.HourSelectors[  11]  .selected  IHEN  outtextxy  (X+xi,  Y+yi+10*th, '11') ; 
IF  q3tr^.HourSelectors[  12]  .selected  IHEN  outtext:y(X+xi,Y+yi+ll*th, '12')  ; 
IF  qatr'.HourSelectors[  13]  .selected  IHEN  outtextxy(X+xi,Y+yi+12*th, '13') ; 
IF  eptr^.HourSelectors[  14]  .selected  THEN  outtexby(X+,xi,Y+yi+13*th, '14') ; 
IF  eptr^.HourSelectors[  15]  .selected  IHEN  outtextxy  (X+xi,  Y+yi+14*th, '15') ; 
IF  q3tr^.HourSelectors[  16]  .selected  IHEN  outtext>y(X+xi,V+yi+15*th, '16') ; 
IF  6ptr^.HourSelectors[  17]  .selected  THEN  outtextxy(X+xi,Ynyi+15*th, '17')  ; 
IF  eptr^.HourSelectors[  18]  .selected  IHEN  cxittexbQ^(X+xi,Y+yi+17*th, '18') ; 
IF  ^)tr'.HourSelectors[  19]  .selected  THEN  outtext>y(X+xi,Y+yi+18*th, '19')  ; 
IF  ^3tr^.HourSelectors[  20]  .selected  THEN  outtextxy  (X+xi,  Y+yi+19*th, '20') ; 
IF  ^jtr^.HourSelectors[21]  .selected  THEN  outtextxy  (X+xi,  Y+yi+20*th, '21') ; 
IF  OTtr^.HourSelectors[  22]  .selected  IHEN  outtextxy  (X+xi,  Y+yi+23*th, '22') ; 
IF  ^)tr''.HcurSelectors[ 23]  .selected  IHEN  outtextjy(X+xi,Y+yi+22*th, '23') ; 
IF  eptr^.HourSelectors[ 24]  .selected  IHEN  outtextxy (X+xi,Y+yi+23*th, '24') ; 

settextstyle(defaultfont,horizdir,l) ; 

Show_Cursor  (xx ,  yy ) ; 
end; 
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^****************************'*'***<t********5k******ifc*******i*#;ik^t****iic****'5fWSt*'sfeJ 


procedure  CellB:pWindcw.Hilite(5^pos,  Ypos:vord) ; 

{ 

************************************************************************ 
*  * 

*  HJRPOSE  * 

*  Dumny  object  method  for  hili^ting  the  summary  cell  query  * 

*"  window.  Deliberately  does  nothing.  * 

************************************************************************ 

) 

begin; 

end-; 


(***************************************************************************) 

function  CellPcpWindcw.Action()$xDS,  Ypcs;  word)  :boolean; 

( 

************************************************************************ 


*  * 

*  HJEPOSE  * 

*  Object  method  for  handling  queries  into  the  month/hour  * 

*  matrix  of  displayed  EAT  values.  * 


************************************************************************ 

) 

var 

i,j:  integer; 
dumrry  ;  boolean; 

begin 

for  i  :=  1  to  12  do  begin 
for  j  ;=  1  to  24  do  begin 
month  :=  i; 
hour  ;=  j; 

SubCellPcxSjp^.HilitedCellPtr  ;=  @SubCells[i, j] ; 
if  SubCells[i, j] .Action(}$>os,Ypos)  then 
begin 

exit;  {  drq3  out  of  the  loops  so  that  the 
hilitedcellptr  doesn't  change  ) 

end; 

end; 

end; 

end; 


(************************'X*********************X****************************^ 


procedure  cellPcpWindow.  Cancel ; 
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{ 

**********★**'.■.********************************************************** 


*  * 

*  PURPOSE  * 

*  Ctoject  method  for  removing  the  summary  cell  query  window  * 

*  fran  the  screen.  * 


************************************************************************** 

} 

begin 

menu. Cancel; 

HilitedCellPtr' .  Cancel ; 
end; 


(***************************************************************************)> 


constructor  SubCellPcfWindow.Init(InitX,InitY,InitWidth,InitHei^t  :  integer; 

InitColor,  InitBorderColor ,  InitTextColor , 
InitSelectedColor:  word; 
InitActionProcrActionProcedure) ; 

{ 

it***************-)!******************************************************* 


*  * 

*  PURPOSE  * 

*  Cbject  initialization  cxxie  for  the  detailed  cell  query  * 

w  window.  * 


************************************************************************ 

) 

var 

labelarray  :  namearray; 
begin 

xoffset  :=  10; 
yoffset  :=  20; 

I<Jenu.  Init  (InitX,  InitY,  InitWidth,  InitHei^t,  InitColor, 

InitBorderColor,  2 , WindcwShadcwWidth-2 ) ; 
labelarray[l]  :=  'A';  labelarray[2]  :=  'B';  labelarray[33  :=  'C'; 
labelartay[4]  ;=  'D';  labelarray[5]  ;=  'E';  labelarray[63  ;=  'T' ; 
labelarray[7]  ;=  'G';  labelarray[8]  :=  'E* ; 

Stations.  Init  (InitX+20,  InitY+20 , 10, 11,  InitColor,  lightblue, 

InitSelectedColor,  InitBorderColor, white,  InitBorderColor, ' ' , 

8,0, labelarray, horizontal) ; 

MEU.Init(InitX+15,InitY+130, 90, 12, white, black,black, white, ' Coverage ',InitActionProc,  'C' 

Bottoiifenu.  Init  (InitX,  InitY+50 ,  InitWidth,  InitHeight+60 ,  InitColor, 

InitBorderColor ,  2 ,  WindowShadCT^idth-2 ) ; 


Pht  ;=  0; 

TextOolor  :=  InitTextColor; 
SelectedColor  :=  InitSelectedColor; 
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BottcnMaiuSHcwn  :=  false; 
end; 


(*************************************************************************** j 

procedure  SubCtellPcpWindcw.FillBottanOfWindw; 

{ 

************************************************************************ 


*  KIEPOSE  * 

*  (Saject  method'  that  displays  the-  cell  database  information  * 

* '  vAieneweEi-a?  station'-is  .sheeted-,  from'  the^^detailedi  cell  * 

*  window.-.  * 

***********************************************************************^ 


var 

xX/yy/Xi/yi  '  integer; 

StationLetter  :  String [1] ; 
fRBQ102, 

FRBQ136, 

SNR102, 

SNR136, 

SLRMn:0102, 

SIPAn0136, 

de:vio2, 

DEV136, 
i^UG102 , 

ANG136, 

STEy.02, 

STR136  :  string[5] ; 

EM102, 

IH136  ;  string[3]; 

Stationinf ol02 ,  stationinf ol3  6 :  stationcoverageinf cptr ; 
DB102,DB136:  DBFile; 

S102 ,  S136 , 1102 , 1136 ,  D102 ,  D136 , A102 , A136 ;  real ; 
RelString:  string; 
relarray:  QRDatabaseSubiype; 
relval;  single; 
relcolor  :  word; 
begin 

Get_CursorXY(xx,yy) ; 

HidejCursor; 

settextstyle(sroallfont,horizdir,4) ; 
settextjustify(lefttsxt,tcptext)  ; 
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xi  :=  5; 
yi  :=  50; 

setcolor(textoolor) ; 

case  Stations. Picked  of 
0:  StationLetter  :*= 

1:  StationLetter  :=  'A'; 
2:  StationLetter  :=  'B'; 
3:  StationLetter  ;=  'C'; 
4:  StationLetter  :*=  'D'; 
5:  StationLetter  :=  'E'; 
6;  StationLetter  := 

7:  StationLetter  'G'; 
8;  StationLetter  :=  'H'; 
end; 


if  Stations. Picked  =  0  then  begin 


IREQ102 

ss  /  /  • 
/ 

rRBQ136 

%:  /  /  « 
/ 

SNR102 

ss  ^  ^  • 
/ 

SNR136 

s:  ^  ^  • 
/ 

SLRAn0102 

a:  /  /  « 

SLRAn0136 

s  ^  • 

EM102 

a-  / 

im36 

a:  9 

DEV102 

DEV136 

5=  '  '  • 

ANG102 

a:  9  9* 

ANG136 

end 

else  begin 


Assign(DB102,nAIAEASEPAIH+'\'+EAIAEASE102)  ; 

Reset (DB102) ; 

Assign(DB136,I3aABASEPAIH+'\'+DA]3ffiASE136) ; 

Reset (DB136) ; 

new  (stationinf  0102) ; 
new(stationinfol36) ; 

ReadFrcjnDatabase  (DB102 ,  CallPopti^ .  callnum,  stationinf ol02 ) ; 
RsadFranDatabase(DB136,CellPq:l^.cellninn,stationinfol36)  ; 

aose(DB102)  ; 
acse(DB136)  ; 
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S102  :=  Get_Sl®<statiordTifol02''[statibns*pic3<Bd,,CellB:^i^.in(:xithvCellE0pUpr.hour3 .SNR^S) 
S136  :=  Get_SNR(stationinfol36^[stations. picked, CellPc^)Up^. month, CellPqpUp^. hour]. SNR_S) 

IF  CenPcpUp^.eptr^.statioipower[stations.picked] ♦on.selected  THEN 
begin 

S102  :=  S102-fCellPopUp^. ^jtr'.statiorpcwer[stations. picked]  .sld. value. value; 

S136  :=  S136+CellPcpUp^. Q3tr^.stationpcwer[stations. picked]  .sld.value.value; 
GetStationReliabilities  (releirray ,  CellPcpUp^ .  eptr' .  QRFile) ; 

CASE  CellldpUp^.eptr^.StationReliabilityJtodel. Picked  OF 
SRMEEST: 

relval  :=  relarray[CellPcpcp<''.Month,stations.picked,S<±ieduled]  + 
relarray[CellPcpc?x' .Month,stations. picked, UnStdieduled] ; 

relval-  :=  rBlai^y[Cell?cpup^. Month, stetions-^pickedy^^  + 

relarray[CellIt!pi:5)'>  .I4fnth>stations.pic}^d;'UnSchBduled]  + 
relarray[CellPcp:5>^. Month, ^tions.pick^, Maintenance] ; 

SPMWRST: 

IF  relarray[CellPDpc?/'. Month, stations. picked, Maintenance]  <>  0  THEN 
relval  :=  0 
ELSE 

relval  :=  relarray[CellPcpc5r'.Mbnth,stations. picked, Scheduled]  + 
relarray[CellPopc5)^.Month,stations. picked, Unscheduled]  -f 
relarray[CellPopc?r'.Month,stations. picked, Maintenance] ; 

end;  {  CASE  ) 

str(relval:6:5,RelString) ; 
relcolor  :=  blue; 
end 
ELSE 
begin 

PelString  :=  '  OFF'; 
relcolor  :=  red; 
end; 


LL02  ;=  Get_SNR(stationinfol02'' [stations. picked,CellPi:5:Up^. month, CellPopUp^. hour]. SNR_L) 
1136  :=  Get_SNR(stationinfol36^ [stations.pick^,CellPq:^Jp^. month, CellPopUp^. hour] .SNR_L) 
STR(  10.2  ;5;1,FREQ102) ; 

STR(  13.6  :5:l,FREai36) ; 

STR(S102:5:1,  SNR102) ; 

STR(S136:5:1,  SNR136) ; 

STR(S102-I102 ;  5 : 1,  SIPAn0102)  ; 

STR(S136-ia36:5;l,  SIPATI0136)  ; 

IF  (stationinfol02''[stations. picked, CellPopUp^.month,CellPcpL^. hour] .Phase  $80)  =  0 

rM102  :=  '  1' 

ELSE 

EM102  :=  '  X'; 

IF  ( staticninf ol3  6  '  [  stations .  picked ,  CellPopUp^ .  mcnrh ,  CellPopUp^ .  hour] .  Riase  AJC  $80)  =  0 
EM136  ;=  '  1' 

ELSE 
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EM136  ;=  •  X'; 

D102  :=  stationiiifol02^[stations.picked,CellFt53Up''.month,CellP:pt^'^ .hour]  .Phase  AND  $7F; 
D136  :=  st2tioninfol36''[stations.picked,CellP^qct^.inonth,CellPcpQp''. hour]  .Phase  AND  $7F; 
STR(D102:5:0,  DEV102) ; 

STR(D136:5:0,  DEV136) ; 

A102  :=  stotioninfol02^[stations.picked,CellPcpUp''.month,CellP>cpUp^.hour]  .X_Arig; 

A136  :=  stationinfol36''[stations. picked,CellPcpUp^. month, CellPcpL^^. hour]  .X_Ang; 
STR(A102:5:0,  ANG102)  ; 

STR(A136:5:0,  ANG136)  ; 

dispose (stationinf 0102) ; 
dispose  (stationinfol36) ; 

setf illstyle  ( solidf  ill ,  relcalor)  ; 

bar  (X-fWidth-textwidth  ( '  1234567  ')-7,  Y+yi+S  ,X+Width-5 ,  Y+yi+5+textheight  ( '  1 ' )  +2 ) ; 
setcolor  (white) ; 

rec±argle  (X+Width-textwidth  ('  1234567 ')  -7 ,  Y+yi+5 ,  X-fWidth-5 ,  Y+yi+S+textheight  ( '  1 ' )  +2 ) ; 
outtext5c/(X-Width-textwidth('EEL:  1234567 ') -5, Y+yi+5, '  '+RelString)  ; 

setcolor  (textcolor) ; 

outtext3Q^(X+Width-textwidth('REL:  1234567')-5, Y+yi+5, 'REL:  ; 

yi  ;=  yi  +  21; 

outtextxy(X+xi,Y+55, 'STATICXI:  '+Stationletter) ; 
outtextxy(X+xi,Y+yi+  0*(texthei^t('l')+3) , '  FREQ:'); 
outtextJQ^(X+xi,Y+yi+  l*(texthei^t('l')+3) , '  SNR:  '); 
outtextxy(X+xi,Y+yi+  2*(textheight('l')+3) , '  S/L:  '); 
outtextxy(X+xi,Y+yi+ 3*(texthei(^t('l')+3),'  EM:  '); 
aittextxy(X+xi,Y+yi+ 4*(texthei^t('l')+3),'  DEV:  '); 
outtextxy(X+xi,Y+yi+ 5*(texthei^t('l')+3) , '  ANG:  '); 

setf illstyle (solidf ill, blue) ; 
setcolor  (white) ; 


bar (X+xi+textwidth( ' 123456789 ' ) -2 , Y+55-1, 

X+xi+textwidth  ('  1234567890 ')  +2 ,  Y+55+2+textheight  ('!')); 
rectangle  (X+xi+textwidth  ('  123456789 ')  -2 ,  Y+55-1 , 

X+xi+textwidth('1234567890')+2,Y+55+3+textheight('l') )  ; 
outtextxy  (X+xi ,  Y+55 , '  '  +StationIjstter) ; 

bar  (X+xi+textwidth  ( '  1234567 ' ) ,  Y+yi-l+o*  (textheight  ( '  1 ' )  +3 ) , 

X+.xi+textwidth ( '  12345678901234567890123 ' ) ,  Y+yi-ln-6*  (textheii^t  ( '  1 ' )  t3  ) )  ; 
outtextxy (X+xi+l , Y+yi+  0* (textheight ( ' 1 ' ) +3 ) , '  ' +FREQ102 ) ; 

outtextxy  (X+xi-l ,  Y+yi+  O*  (texthei^t  ( '  1 ' )  +3 ) , '  '  +FREQ13  6 )  ; 

if  (S102  <  Rcund(CellPcpi:^. epuT''. SNR. value. value) )  then 
setf illstyle ( solidf ill , red) 
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el^ 

setf illstyle  (solidf-ill ,  blue).; 

bar('X+xi4-textwidth(/ 1234567'  )  ,Y+yirl€l*(texthei^'(;'l'0  +3) , 

X+xi+textwic3th ( ' 123456789012345 ' ) , Y+yi-1+2* (textheight ( ' 1 ' ) +3 ) ) ; 

if  (S136  <  Itourxi(CellPc^!l^^.eptr*. SNR. value. value))  then 
setf  illstyle  ( solidf  ill ,  red) 
else 

setfillstyle (solidf ill, blue) ; 

bar  (X+xi+textwidth  ( '  123456789012345 ' ) ,  Y+yi-1+1*  (texthei^t  ( '  1 ' )  +3 ) , 

X+xi+textwidth ( ' 12345678901234567890123 ' ) , Y+yi-1+2* ( textheight ('l')+3)); 
outtextxy(X+xi,Y+yi+  l*{texthei^t('l')+3) , '  '+SNR102+'  '+SNR136) ; 

if  (S102-L102  <  RDund(CellPopUp^. eptr^.ShortlongRatio. value. value) )  then 
setfillstyle ( solidf ill , red) 
else, 

setfillstyle ( solidf ill , blue) ; 

bar  (X+xi+textvddth  ('  1234567 ') ,  Y+yi-1+2*  (texthei^t  ( '  1 ' )  +3 ) , 

X+xi+textwidth ( ' 123456789012345 ' ) , Y+yi-1+3* (textheight ( ' 1 ' ) +3 ) ) ; 
if  (S136-I2.36  <  Raind (CellPcpUp^.e^rtr^.ShortLongRatio. value. value) )  then 
setf illstyle (solidf ill , red) 
else 

setfillstyle ( solidf ill , blue) ; 

bar(X+xi+textwidth('123456789012345') , Y+yi-1+2* (textheight ('l')+3) , 

X+xi+textwidth ('12345678901234567890123') ,Y+yi-l+3 *( textheight ('l')+3) ) ; 
cxittextxy(X+xi,Y+yi+  2*(texthei^t('l')+3),'  '+SIRATI0102+'  '+SIRATI0136)  ; 

IF  (stationinfol02''[stations.picked,CellPoE«p^.TOonth,CellPc:?i;p^. hour] .Phase  AND  $80)  =  0 
setfillstyle ( solidf ill , blue) 

ELSE 

setfillstyle ( solidf ill , red) ; 

bar  (X+xi+textwidth  ('  1234567 ') ,  Y+yi-1+3*  (texthei^t  ( '  1 ' )  +3 ) , 

X+xi+textwidth('123456789012345')  ,Y+yi-l+4* (textheight ('!') +3) ) ; 

IF  (stationinfol36'' [stations. picked, CellPopUp^. month, CellPopUp''. hour] .Phase  AND  $80)  =  0 
setfillstyle ( solidf ill ,blue) 

ELSE 

setfillstyle (solidf ill, red) ; 

bar(X+xi+taxtwidth('123456789012345') , Y+yi-1+3* (textheight ('1') +3) , 

X+xi+textwidth ( ' 12345678901234567890123 ' ) , Y+yi-1+4* (textheight ('l')+3)); 
outtextxy(X+xi,Y+yi+  3*(texthei^t('l')+3),'  '+EM102+'  '+CM136) ; 

if  (D102  <=  Round (CellPcpUp^.eptr^. FhaseDev. value. value) )  or 

(D102  >=  100  -  Rcund(CellIt5:Up^. eptr^.FhaseDev. value. value) )  then 
setfillstyle (solidf ill , blue) 
else 

setf illstyle (solidf ill, red) ; 

bar  (X+xi+textwidth  ('1234567'),  Y+yi-1+4  *  (textheight  ( '  1 ' )  +3 ) , 

X+xi+textwidth ( '  123456789012345 ' ) ,  Y+yi-1+5*  (texthei^t  ( '  1 ' )  +3 ) )  ; 
if  (D136  <=  Round (CellProUp^.eptr''.FhaseDev. value. value) )  or 
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(D136  >=  100  -  RDund(CellPopUp^. ^jtr^.PhaseDev.value. value) )  then 
setfillstyle (solidf ill , blue) 
else 

setfillstyle  (solidf ill,  red) ; 

bar  (X+xi+textwidth ( '  123456789012345 ' ) ,  Y+yi-1+4*  (textheight  ( '  1 ' )  +3 ) , 

X+xi+textwidth  ( '  12345678901234567890123 ' ) ,  Y+yi-1+5*  (texthei^t  ('l')+3)); 
cuttext}y(X+xi,Y+yi+  4*(texthei^t('l')+3) , '  '+EEV102+'  '+DEVa36)  ; 

if  (A102  >=  Rcund (CtellPcpUp^.qjtr^.XAngle. value. value) )  then 
setfillstyle  ( solidf  ill ,  blue) 
else 

setf  illstyle  (solidf ill,  rad) ; 

bar  (X+xi+taxtwidth  ('  1234567 ') ,  Y+yi-1+5*  (textheii^t  ( '  1 ' )  +3 ) , 

X+xi+textwidth  ( '  123456789012345 " ) ,  Y+yi-1+6*  (textheight  ( '  1 ' )  +3 ) )  ; 

if  (A136  >«=  Raurd(CellB3pUp^.eptr'.XAngle. value. value))  then 
setfillstyle (solidf ill , blue) 
else 

setfillstyle (solidf ill,  rad) ; 

bar  (X+xi+textwidth  ('  123456789012345 ') ,  Y+yi-1+5*  (textheight  ( '  1 ' )  +3 ) , 

X+xi+textwidth  ( '  12345678901234567890123  > ) ,  Y+yi-1+6*  ( texthei^t  ('l')+3)); 
outtext:jy(X+xi,Y+yi+  5*(texthei^t('l^)+3) , '  '+ANG102+'  '+ANG136) ; 

(*  draw  the  vertical  and  horizontal  lines  to  enclose  the  data  *) 

line  (X+xi+textwidth  ('  1234567 ') ,  Y+yi-1+0*  (textheight  ( '  1 ' )  +3 ) , 

X+xi+textwidth  ( '  1234567  • ) ,  Y+yi-1+6*  (textheight  ( '  1 ' )  +3 ) ) ; 
line  (X+xi+textwidth  ( '  123456789012345 ' ) ,  Y+yi-1+0*  ( texthei^t  ( '  1 ' )  +3 ) , 
X+xi+textwidth  ( '  123456789012345 ' ) , Y+yi-1+6*  (textheight  ( '  1 ' )  +3 ) ) ; 
line  (X+xi+textwidth  ( '  12345678901234567890123 ' ) ,  Y+yi-lf-0*  (textheight  ( '  1 ' )  +3 ) , 
X+xi+textwidth ('12345678901234567890123')  ,Y+yi-l+6* (textheight ('!') +3) )  ; 

line (X+xi+textwidth ( ' 1234567 ' ) , Y+yi-1+0* (textheight ( ' 1 ' ) +3 ) , 

X+xi+textwidch ( '  12345678901234567890123 ' ) ,  Y+yi-1+0*  (textheight  ( '  1 ' )  +3 ) )  ; 
line  (X+xi+textwidth  ( '  1234567 ' ) ,  Y+yi-l+i*  (textheight  ( '  1 ' )  +3 ) , 

X+xi+textwidth  ( '  12345678901234567890123 ' ) ,  Y+yi-1+1*  (textheight  ( '  1 ' )  +3 ) )  ; 
line  (X+xi+textwidth  ('  1234567 ') ,  Y+yi-1+2*  (textheight  ( '  1 ' )  +3 ) , 

X+xi+textwidth ('12345678901234567890123') , Y+yi-1+2* (texthei^t('l')+3) )  ; 
line  (X+xi+taxtwidth  ('  1234567 ') ,  Y+yi-1+3*  (textheight  ( '  1 ' )  +3 ) , 

X+xi+textwidth  ( '  12345678901234567890123 ' ) ,  Y+yi-1+3*  (textheight  ( '  1 ' )  +3 ) )  ; 
line  (X+xi+textwidth  ( '  1234567 ' ) ,  Y+yi-1+4*  (texthei^t  ( '  1 ' )  +3 ) , 

X+xi+textwidth  ( '  12345678901234567890123 ' ) ,  Y+yi-1+4*  (textheight  ( '  1 ' )  +3 ) )  ; 
line  (X+xi+texcwidth  ( '  1234567 ' ) ,  Y+yi-1+5*  (textheight  ( '  1 ' )  +3 ) , 

X+xi+taxtwidth('12345678901234567890123') ,  Y+yi-l+S*  (textheight (' 1 ') +3 ))  ; 
line (X+xi+textwidth  ( ' 1234567 ' ) , Y+yi-1+6* (textheight ( ' 1 ' )  +3 ) , 

x+xi+taxtwidth(' 12345678901234567890123') , Y+yi-1+6* (textheight (' 1 ') +3 ) ) ; 

settextstyle(defaultfont,horizdir,l) ; 
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{  oniyj;  sh(y^aBi^gfeivafee-*the-^MBOfvbateton~i:g‘a--staMGn*,isrselegH^!t)'  - 
IF^NDT'  MDCr  shosJh' 

MDCJjshown  :=  TRUE; 
addtotablist  ( 'SubCellBspUp' ,  @MDa)  ; 
end; 

MDU.ChangeXif(X+  30,y+139)  ; 

MDU.Shcw; 

end;  {  else  clause  of  if  picked  =  0  ) 

Show^Cursor  (xxv  yy)-^; 
end; 


(**Jt;***'ilc*****';^i^.*3c*i*ilE.^^**'*******.*,****%St****it****'feA^^’k************************) 


procedure  SubCellPcfWinda^.Shcv; 


★A********************************************************************** 


*  PURPOSE  * 

*  Ctoject  method  to  display  the  top  part  of  the  detailed  cell  * 

*  query  window,  * 

************************************************************************ 


var 

hour,  month  :  integer; 
i,th,tw,xi,yi,xx,yy:  integer; 
mon,hr,PatStr,  GDOEStr,  GDOPstrl  :  string; 
g(%r/alue ,  code :  integer ; 

begin 

GGt_cursorXY  (XX, yy) ; 

Hide_Cursor; 

Window.  Show; 
setcolor(TextColor) ; 
settextstyle(sraallfont,hori2dir,4) ; 

th  :=  textheight('l')  +  2; 
tw  ;=  textwidth('l')  +  2; 
xi  :=  xoffset+textwidth('l')-2; 
yi  :=  yoffset; 

settextstyle(defaultfont,horizdir,l) ; 

Stations .  Changexy  (X+xi ,  y+yi) ; 

Stations. Picked  :=  0; 

for  i  :=  1  to  Stations.NumberButtons  do  begin 
Stations .  ButtonArray  [  i  ] .  TumOf  f ; 
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if  (HilitedCfellPtr^.Wei^tjOrjCiJverage  and  ($80  SHR-  (i-l)))  >  0  then  begin 
StatioI^s.ButtonArray[i].SelectedColor  :=  SelectedColor; 

Stations. ButtonArray[i]. Color  :=  SelectedColor; 
end 

else  begin 

Stations. ButtonArray[i]  .Color  :=  Color; 

Stations. ButtonArray[i]  .SelectedColor  :=  Color; 
end; 
end; 


Stations .  Shew; 

settextstyle(sinallfont,hori2dir,4) ; 
settextjustify(lefttext,bcptext)  ; 

Pat  :=  HilitedCellPtr^.Pac; 
str(Pat:7;6,I^tStr)  ; 

PatStr  ;=  'P  '  +  PatStr; 

if  Pat  <  cellPcpi^/'.eptr^.Psa. value. value  THEN 
begin 

setf illstyle ( solidf ill , red) ; 

bar (x+4 ,y+3 ,x+4+tejctwidth(PatStr)+l,y+3+texthei^t (PatStr)+2) ; 
end; 

outtextxy (X+5 , Y+3 , PatStr) ; 
outtextxy(X+5+tw,Y+5,  'AT') ; 

GDOPStrl  :=  GetGdcp(cellpcpc5>^.CellNum, 

HilitedCellPtr'  .weight_or_coverage) ; 

GDOPStr  :=  'GDOP  '  +  GDOPStrl; 

GDPValue  :=  ReadGdc^(cellpcpimr  .CellNum, 

HilitedCellPtr^.wei<^t_or_coverage) ; 

if  (GDOPStrl  =  'N/A')  OR  (GDOPStrl  =  '>  25')  THEN 
begin 

setf  illstyle  ( solidf  ill ,  red) ; 

bar  (X+width-textwidth  (GDOPStr)  -6 ,  Y+3 , 

X+width-6+l,y+3+texthei^t (GDOPStr) +2) ; 
end 
ELSE 
begin 

if  (gmvalue  >  cellpopcp^.e^ra:''. GDOP. value. value*  10)  then 
begin 

setf illstyle ( solidf ill , red) ; 

bar  (X+width-te.xtwidth  (GDOPStr)  -6 ,  Y•^3 , 

X+width-6+l,y+3+texthei^t (GDOPStr) +2)  ; 
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eniii 

end; 


outtextxy-  (X4width-textwidth  (GDOPStr )  -5 ,  Y+3 ,  GDOPStr)  ; 

str(CtellPcpC^.hcur,hr) ; 
if  CellPcpUp^  .hcur  <  10  then 
hr:=  '0'  +  hr  +  '00' 
else 

hr:=  hr  +  '00'; 

outte>ctxy(X+5/Y+35,M3ntiTNames[C^lPcpi43?'.Month3+'  '+hr) ; 

( *Fill£cfttaiOfWindow ;  * ) 

settejrt:style(defaultfont,hori2dir,l)  ; 

Shcw_CXirsor(xx,yy) ; 
end; 


^ **************************************************************************** j 

function  SubCellPofWindow.Action()$xDs,  Ypos:  word)  rboolean; 

{ 

***i^******************************************************************** 
*  * 

*  PURPOSE  * 

*  Object  method  that  handles  the  selection  of  a  station  for  * 

*  display  of  the  database  information  on  the  bottom  half  of  * 

*  the  detailed  cell  query  window.  * 

************************************************************************ 

} 


var 

dummy  :  boolean; 
begin 

Action  :=  FALSE; 

if  Stations. Action(Xpos, Ypos)  then 
begin 

if  not  EcttoitfenuShcwn  then 
begin 

Bottoiifenu .  Shew ; 
EottoiifenuShcwn  :=  true; 
end; 

FillBottanOfWindcw; 

Action  ;=  TROE; 
end; 

IF  stations. picked  >  0  HiEN 
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IF  MDU. Action (XpoSjYpos)  TEiEN 
Action  :=  TRUE; 

end; 


(*************************************************************************** j 


function  SubCellPqp*^indc:w.KeyAction(Xpos,Ypos:word;3cey:integer)  :boolean; 

{ 

★★Ik********************************************************************* 
*  * 

*  HJRPOSE  * 

*  Hotkey  object  handling  itiethcd  for  the  detailed  cell  query  * 

*  window.  * 

*******************************************<>**************************** 


begin 

Keyaction  FALSE; 

IF  stations. picked  >  0  THEN 

Keyaction  :=  MDU.KeyAction(Xpos,Ypo£,key) ; 

end; 


(*************************************************************************** j 


procedure  SubCellPcipWirvdcw.Hilite(J^30s,Ypos;word) ; 

{ 

************************************************************************** 


*  * 

*  HJRPOSE  * 

*  Hi'^i<^t  routine  that  handles  the  hi^ighting  of  the  * 

*  coverage  display  canmand  button  CNLY  when  the  lower  half  * 

*  of  the  detailed  cell  query  window  is  sliown.  * 


************************************************************************ 

} 


begin 

Stations.Hilite(}$X5S,Ypos)  ; 
IF  stations. picked  >  0  THEN 
MEU.Hilite(}axs,Ypos) ; 

end; 


(***************************************************************************^ 


procedure  SubCellRx»*7indcw.  Cancel ; 

{ 

*******************************************************w************x*** 
*  * 

*  RIRPOSE  * 

*  Method  for  removing  the  detailed  cell  query  window  from  * 
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*  the*  display.  . 

**#:fe'Vlr****'*'JtW5fVlry*'S*******'*^5t'*'**^t*'*****************ilr*"******3k************** 

} 


begin 

IF  MDCJ_shown  THEN  begin 
MDQjshcwn  :=  FfilSE; 

deletefraratablist  ( '  SubCellPqpL^ ' ,  §MDU)  ; 
end; 

if  BcttonMenuShcwn  then 
begin 

BottcsnfSenuShcwn  :=  false; 

BottaiWenU'.  Hide 
end; 

itv^u.  Cancel; 

HilitedCellPtr^ . Cancel ; 
end; 


(***************************************************************************) 

constructor  DiffCellIcpWindcw.Init(InitX,InitY,IriitWidth,InitHei^t  ;  integer; 

Initbnlor',  InitBorderColor,  InitTextColor , 
InitHiliteColor,InitSelectedColor:  word); 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Ctoject  initialization  for  the  difference  display  query  * 

*  window.  * 


************************************************************************ 

} 


begin 

menu.  Init  (InitX,  InitY,  InitWidth,  InitHei^t,  InitColor, 
InitBorderColor ,  2 ,  WindcwShadowWidth-2 ) ; 
TextColor  :=  InitTextColor; 

SelectedColor  :=  InitSelectedColor; 
end; 


(***************************************************************************^ 


procedure  DiffCellPcpWindow.Show; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Object  display  metJicd  for  the  difference  display  query  * 

*  window.  * 


******************************************* ****x********x***********?c*** 
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) 

var 

i,X5£,yy,inon,hr,xi,yi,tw,th  :  integer; 
LPacStr,KPacStr,PacStr,deltastr  :  String; 
lval,rval,denan,val  ;  Real; 

begin 

GetjCursorX!^  (xx,yy)  ; 

Hide__Cursor; 

Windcw.Show; 

setcolor(TextColor) ; 

settext j  ust ify  ( lefttext ,  tcptext ) ; 

xi  ;=  70; 

yi  :=  5; 

outtextxy(x+xi,y+yi,  'Left  Right') ; 

Ival  :=  leftcellgrid''.cellarray[HilitedCellPtr^.cellniniber]  .pac; 
rval  :=  ri^tcellgrid-' . cellarray[HilitedCellPtr^ . cellnuniber]  .pac; 

str(lval:5:4,LPacStr) ; 
str(rval:5;4,RPacStr) ; 

PacStr  :=  'P  '  +  LPacStr  +  '  '  +  RPacStr; 
yi  :=  yi  +  14 ; 

outtextoQT  (X+10 , Y+yi , PacStr) ; 
tw  :=  textwidth('P') ; 
outtextxy (X+lO+tw, Y+yi+4 , 'AC' ) ; 

IF  abs(lval  ~  rval)  <  0.00001  THEN 
val  :=  0 
ELSE 

CASE  diffmenu^.diffinode. picked  OF 
1:  val  ;=  Ival  -  rval; 

2: 

begin 

IF  Ival  >  rval  THEN 
denom  :=  Ival 
ELSE 

denan  :=  rval; 

IF  denan  o  0  THEN 

val  ;=  (lval-rval)/denom 
ELSE 

val  ;=  1; 

end; 

3: 

begin 

IF  (1-lval)  >  (1-rval)  THEN 
denan  :=  1  -  Ival 
ELSE 
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IF  (daxxn)  o  0  IHEN  ‘ 

val  :=  ((l-lval)-(l-rval)  )/denan 
ELSE 

val  :=  1; 

end; 

end;  {  case  ) 
yi  :=  yi  +  20; 
str(val;5:4,deltastr) ; 

outtext3iy:(X+30VY+yi,cte(127)  +  ^  *  +  deltastrr) ; 

Show_Cursor(xx,yy) ; 
end-; 

(*********************************************•>*****************************) 

procedure  DiffCellB::pWirricw,  Cancel ; 

( 

************************************************************************ 


*  * 
*■  PURPOSE  * 

*  Method  for  removing  the  difference  display  query  windcw  * 

*  fron  the  display.  * 


************************************************************************ 

) 

begin 

menu. Cancel; 

HilitedCellPtr'' .  Cancel ; 
end; 


F-26 


File  N^:  CHECKMEM.PAS 


j *********************************************************************** 


*  * 

*  HaDGRAM  -NAME-  -  Omega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME  -  Part  of  PACEDBJS  unit  * 

*  * 

* 

*  Bus  program  was  prepared  by  * 

*  * 

*  The  Ai^ytic  Science^  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading-,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  PC/AT  or  conpatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  coipatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  Dr0323-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  omega  Navigation  System  Cat  r  (C»ISCEN) ,  Alexandria,  VA.  * 

*  * 

************************* ^********************************************** 
*  * 

*  RMOSE  * 

*  Utility  routine  for  reporting  the  amount  of  available  * 

*  system  memory.  Invoked  by  AUW-I.  NOT  A  DOCUMENTED  PACE  * 

*  FEATURE.  * 

*  * 


****************************-x*****x************************************* J 


procedure  CheckMemory(key  ;  integer) ; 
var 

ma  :  longint; 

M_avail, 

T_avail  :  string; 
begin 

if  (key  =  177)  then  begin  (*  alt  m  *) 
ma  :=  memavail; 
str(ma,T_avail) ; 
ma  :=  maxavail; 
str(ma,M_avail) ; 

messagebox.displaymessage((GetMaxX  DIV  2)  -  (textwidth( 'Total  Available  Memory  =  '  -  T  a 

(GetMaxY  DIV  2)  -  (texthei(^t ( '  1 ' )  DIV  2) , 
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2/.. 

length('TcftM  AvHulable  Miiory  =-  '+  , 

Hatred, 

vMte, 

'Itotal  Available  Memary  =  '  +  Travail  + 

'Max.  Contiguous  Memory  =  '  +  M_avail) ; 

messagewait; 
messagebox. hidemessage ; 
end; 
end; 
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UNIT  ConMan;  {cxaitext  manage  vinit  for  dsject  oriented-  control's} 

l***'****************************************************^?*************** 


*  * 

*  rKX3»M  NftME  -  Croega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*,  * 

*■  UNIT  NAME  -  OONMAN  * 

*  * 

★★A********************************************************************* 
*  * 

*  Hiis  program- was  pr^jared  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  conpatible  * 

*  under  MS-DOS  3.3  or  hicher  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccarpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Cmega  Navigation  System  Center  (ONSCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 


*  fURPOSE  * 

*  Manages  the  context  list  which  contains  \diich  windows  * 

*  and  c±>jects  are  currently  active  and  displayed.  Also  * 

*  handles  a  stack  of  displayed  windows  so  that  they  can  * 

*  be  removed  in  the  prcper  order.  Maintains  the  list  of  * 

*  hotkeys.  All  user  iiput  passes  throu^t  the  context  * 

*  manager  airi  is  parsed  out  to  the  appropriate  object  * 

*  by  either  hotkey  association  or  by  user  selected  screen  * 

*  location  (i.e.,  the  mouse  coordinates  ).  * 


********* ***************************************************************j 


Interface 

Uses  Controls,  CursrChj; 


Procedure  CreateContext(ContextN3me:shorxstring) ; 

Procedure  AddroContext(ContextName:shortstring;  CtojrControlPtr) ; 
Procedure  AddroTabList(ContextName;shortstring;  Obj:Control?tr) ; 
Procedure  DeleteFrcmContext(ContextName:  shortstring;  ObjrControlPcr) ; 
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Procedure  DeleteFrOTfl^List(ContextName:^oftetring';'  CSiij  :Qi)ntiolPtx) 
Procedure  PushCorit:ext(Q3ntextNaiiK:shortsturing) ; 

Procedure  PcpContext; 

Procedure  SwitdiContextCCtontextNaiie:  shortstring) ; 

Procedure.,  SHa^ntext;' 

PfocedixreiHideCtontext'? 

Pr5cedur^ '• 

Procedure  ActionContext  ( ,  Ypos :  word) ; 

Procedure  KeyActionContext(}$)os,  Ypos; word;  key ; integer) ; 

Function  TqpContext; boolean; 

Procedure  CancelContext; 

Function  QorxentCtontext:  shortstring; 


Inplementation 

Type 

ctlptr  =  ^ctl; 
ctl  =  record 

next,prev;  ctlptr; 
cbj;  Controlptr; 

end; 


ContextElementPtr  =  ^ContextElement; 

ContextElement  =  record 

naine ;  shortstring ; 

nextelement ,  prevelement :  ContextEleirentPtr ; 
controllist:  ctlptr ; 

end; 


ContextPtr  =  ^Context; 

Context  =  record 

Element :  contextelemantocr ; 
nextcontext :  contextptr ; 

end; 


Var 
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contextlistjtablist  :  Contextptr; 
cxntext5xx)l,ta3:pcx)l  :  OontextElenentPtx; 


Procedure  CreateCcaTtext(03ntextName:shortstxing) ; 

{ 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Associate  a  name  with  a  context.  A  context  is  a  collection  * 

*  of  objects  that  are  active  at  the  same  time.  * 

************************************************************************ 

) 

var 

chaser:  ContextElementPtr ; 
begin 

If  contextpool  =  NIL  THEN 

begin  {  if  no  contexts  exist,  create  the  first  new  context  and  tab  list  ) 
new  (contextpool) ; 
contextpool^. name  :=  contextnaroe; 
contextpool -'.nextelement  :=  NIL; 
contextpool''. prevelement  :■  NIL; 
contextpool ''.controllist  ;=  NIL; 

new(tabpool) ; 

talpool''.name  :=  contextname; 
tabpool^.nextelement  :=  NIL; 
tatpool''.preveleinent  :=  NIL; 
tal:^xx3l''.controllist  :=  NIL; 
end 
EL5E 

begin  {  context  and  tab  pool  alreai^  exist,  add  to  end  of  each  } 
chaser  :=  contextpool; 

While  chaser''. nextelement  o  NIL  DO 
chaser  :=  chaser'. nextelement; 
new  (chaser^,  nextelement) ; 
chaser^. nextelement''. name  :=  contextname; 
chaser"'. nextelement-'. nextelement  :=  NIL; 
chaser^. nextelement^. prevelement  :=  chaser; 
chaser'. nextelement''. controllist  :=  NIL; 

chaser  :=  tahpcol; 

While  chaser'. nextelement  <>  NIL  CO 
chaser  :=  chaser"'. nextelement; 
new  (chaser"',  nextelement) ; 
chaser''. nextelement^. name  :=  contextname; 
chaser^. nextelQT^it-'. nextelement  :=  NIL; 
chaser^. nextelement-'. prevelement  :=  chaser; 
chaser''. nextelement-'. controllist  :=  NIL; 
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end?' 

end;' 

Procedure  AdjJToContextCContextNamershprtstring?  CtojrControlPtr) ; 

{ 

*************************************************************,*********** 
*  * 

*  roRPOSE  * 

*  Add  a  new  c±iject  to  an  alreacty  created  context  (created  * 

*  with,  dreatecontext.  * 

************************************************************************* 

} 

var 

chaser :  Cdntexkelemmtptr?  • 
obj  chaser:  ctlptr; 
begin 

chaser  :=  contextpool? 

While  (chaser'. nextelement  o  NIL)  AND  (chaser ''.name  o  contextname)  DO 
chaser  :=  chaser''. nextelement; 

If  chaser^. controllist  =  NIL  THEN 
begin 

new (chaser^ . controllist) ; 
chaser^. controllist''. next  ;=  NIL? 
chaser'. controllist''. prev  :=  NIL? 
chaseT'. controllist^. cbj  :=  CSoj? 
end 
EI5E 
begin 

obj  chaser  chaser^,  controllist; 

While  ci)j chaser'. next  o  NIL  DO 
objchaser  :=  cbj  chaser '.next; 
new  (obj  chaser'',  next) ; 
c±»j  chaser',  next ''.next  :=  NIL; 
cbj chaser'. next'. pirev  ;=  (±>j chaser; 
cbj chaser'. next'. ciij  :=  Obj; 
end; 
end; 


Procedure  AddTOTabList  ( ContextName ;  shortstring ;  C&  j :  ControlPtr ) ; 

{ 

*  * 

*  PURPOSE  * 

*  Add  a  r^ew  cbject  to  the  list  of  <±)jects  that  will  be  * 

*  hi^ightad  by  repeatedly  pressirg  the  TAB  or  SHIFT-TAB  key* 

********'****'*********'**'x*x*********>r********x****x'>c*****'******'*7f****x**'* 

} 


var 
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chaser:  Contextelementpfer ; 
objciaser:  ctlptr; 

begin  {  add  dDject  pointers  to  the  tab  list  associate  with  the  named  context  ) 
chaser  ;=  tahpool; 

While  (ciHser'.nextelement  <>  NIL)  AND  (chaser ''.name  o  contextname)  DO 
chaser  :=  chaser^. nextelement; 

If  chaser^. controllist  =  NIL  THEN 
begin 

new  (chaser',  controllist) ; 
chaser'. controllist''. next  :=  NIL; 
chaser'. controllist''. prev  :=  NIL; 
chaser .controllisT'.cijj  :=  Ctoj; 
end 
EISE 
begin 

cbj chaser  :=  chaser^. controllist; 

VJhile  c±)j chaser  .next  o  NIL  DO 
objchaser  :=  cisj chaser  .next; 
new (chj chaser  .next) ; 
ctoj chaser  .next ''.next  :=  NIL; 
cbj  chaser  .next'',  prev  :*=  cbjchaser; 

(±) j chaser'', next''. obj  :=  Ctoj; 
end; 
end; 

Procedure  DeleteFranContext  ( ContextName ;  shortstring ;  Cbj ;  ControlPtr ) ; 

{ 

*******************************************i*t**************************** 
*  * 

*  HJRPOSE  * 

*  remcfve  an  chject  from  the  list  assocaited  with  a  particular* 

*  context.  It  (the  chject)  will  no  longer  be  active  in  this  * 

*  context.  * 

************************************************************************ 

) 

var 

chaser;  Contexteleroentptr ; 
objchaser:  ctlptr; 
begin 

chaser  :=  contextpool; 

While  (chaser .nextelement  o  NIL)  AND  (chaser. name  o  contextname)  DO 
chaser  ;=  chaser''. nextelement; 

IF  chaser''. controllist  <>  NIL  IHEN 
begin 

cbjchaser  ;=  chaser''. controllist; 

While  (obj  chaser ''.next  o  NIL)  AND  (cbjchaser  .obj  <>  Obj)  DO 
cbjchaser  :=  cbjchaser  .next; 

IF  cbjchaser  o  chaser'' .  controllist  THEN 
begin 
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ciijchaseE^ipjseV’A.n^- .  :="c:i)j^ias!ei??-;nexfe.'^ 
obj chaser'. next''. prev  :=  cbj chaser ^.prev; 
end 
ELSE 

chaser^. controllist  :=  cbj chaser''. next; 
dispose  (cbj  chaser) ; 
end; 
end; 


Procedure  DeletePircjifl?abList((:tontextName; shortstring;  Ctoj  rControlPtr) ; 

{ 

**********;*******■******************************************************* 


*  V  * 

*•-  FWRBiJSEi  * 

*  remove  an  doject  fran  the  tab  list  associated  with  a  * 

*  particular  context.  It  (the  object)  will  no  longer  be  * 

*  accessible  by  tabbing  through  the  list  * 


************************************************************************ 

} 

var 

chaser;  Contextelement^Jtr ; 
cbj  chaser:  ctlptr; 
begin 

chaser  :=  Tai^xxsl; 

VJhile  ( chaser^. nextelement  o  NIL)  AND  (chaser'. name  o  contextname)  DO 
chaser  :=  chaser'. nextelement; 

IF  chaser'. controllist  o  NIL  THEN 
begin 

cbjchaser  :=  chaser'. cx)ntrollist; 

While  (cbj  chaser",  next  <>  NIL)  AND  (cbj  chaser '.cbj  <>  Cbj)  DO 
cbjchaser  :=  cbj  chaser',  next; 

IF'  cbjchaser  o  chaser". controllist  THEN 
begin 

cbj  chaser",  prev'.  next  :=  cbj  chaser",  next; 
cbj  chaser",  next',  prev  ;=  cbj  chaser '.prev; 
erd 
ELSE 

chaser',  controllist  ;=  cbj  chaser '.next; 
dispose  (cbj chaser) ; 
end; 
end; 


Procedure  PushCOntext  ( ContsxtName :  shorrstring) ; 

{ 

**************************************,c**********x*x**x****x*x7C******x:** 

*  X 

*  PURPOSE  X 

*  add  a  new  context  to  the  context  stack.  The  previously  * 

*  displayed  contexts  are  all  pushed  down  one  level  * 
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************************************************************************ 

} 

var 

chaser:  Qsntextelementptr ; 
teitp:  Contextptx; 

begin  {  push  the  context  and  tab  list  onto  the  stack  ) 
chaser  :=  contextpool; 

While  (chaser^. nexteleraent  o  NIL),  AND  (chaser^. name  o  contextname)  DO 
chaser  :=  chaser^. nextelement; 
new(tenp) ; 

tenp^.nextcontext  ;=  contextlist; 
tenp^. element  :=  chaser; 
contextlist  :=  tenp; 

chaser  :=  tabpool; 

While  ( chaser'. nextelement  <>  NIL)  AND  (chaser ''.name  o  contextname)  DO 
chaser  :=  chaser''. nextelement; 
new(temp) ; 

tenp^.nextcontext  :=  tablist; 
tenp'', element  :=  chaser; 
tablist  :=  teirp; 

end; 

Procedure  PopContext; 

{ 


*  * 

*  HJRPOSE  * 

*  Pemove  a  context  fran  the  context  stack.  The  previously  * 

*  next  context  on  the  stack  becomes  the  current  context.  * 


************************************************************x*********** 

} 

var 

tenp:  Contextptr; 
begin 

IF  contextlist ''.nextcontext  o  NIL  THEN 
begin 

tenp  :=  contextlist; 

contextlist  :=  contextlist ''.nextcontext; 
dispose  (tenp) ; 

tenp  :=  tablist; 

tablist  :=  tablist^. nextcontext; 
dispose  (tenp) ; 
end; 
end; 


Procedure  SvitchCcntext  ( ContextName :  shortsorii^) ; 
{ 
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*  * 

*  HJRPOSE  * 

*  Switdi  to  another  context  by  making  the  desired  one  the  * 

*  current  context  and  placing  it  on  tcp  of  the  context  stack.* 
************************************************************************ 

) 

var 

chaser:  Contextelem^tptr ; 
tenp:  Cdntextptr; ' 
begin 

chaser  :=  context^jpoi; 

While » (chaser^. n®£telement  O'  Nlii)  ANE)'^( chaser^. naroe^o  contextnaroe|,  DO: 

chhser  :=  chaSj^.nextSelement; 
contextlist'^. element  :=  chaser; 


chaser  :=  tatpool; 

While  ( chaser^-. nextelement  o  NIL)  AND  (chaser ''.name  <>  contextname)  DO 
chaser  :=  chaser^. nextelement; 
tablist^. element  :=  chaser; 
end; 


Procedure  ShcwContext; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Shew  (display)  all  cbjects  that  are  associated  with  the  * 

*  context  that  is  on  the  top  of  the  context  stack.  Each  * 

*  ctoject's  SKCW  method  in  the  context  will  be  invoked.  * 


************************************************************************ 

) 

var 

objehaser :  ctlptr ; 
begin 

objehaser  :=  contextlist''. element ''.controllist; 

while  ebjehaser  o  NIL  Do 

begin 

cbj  chaser^ .  cbj .  shew  ; 
ebjehaser  :=  ebjehaser'. next; 
end; 
end; 


Procedure  HideContext; 

{ 

*****************************************************x***x************** 
*  * 

*  PURPOSE  * 

*  Hide  (undisplay)  all  objects  that  are  associated  with  the  * 
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*  context  that  is  on  the  tcp  of  the '-context  stack'.  Each  * 

*  object's  HIDE  method  in  the  context  will  be  invoked.  * 

************************************************************************** 

} 

var 

cbj  chaser:  ctlptr; 
begin 

cbj  chaser  :=  cx)ntextlist^.  element^,  controllist; 

while  cfojchaser  o  NIL  Do 

begin 

cbj  chaser^ .  cbj  ^ .  Hide ; 
cbjchaser  :=  cbj  chaser^,  next; 
end; 
end; 


Procedure  HiLiteContext  (}^xds  ,  Ypos :  word) ; 

{ 

********************************'**'*'********************************'V**** 


*  * 

*  PURPOSE  * 

*  Hi^iLi^t  all  cbjechs  that  are  asscjciated  with  the  * 

*  cxDHtext  that  is  on  the  tcp  of  the  context  stack  AND  whose  * 

*  'hot'  area  encloses  the  input  x/y  coordinates.  Each  * 

*  cbject's  HITJIE  method  in  the  context  will  be  invoked.  * 


**********************************************x************************* 

} 

var 

cbjciiaser:ctlptr; 

begin 

obj chaser  :=  contextlist''. element^. controllist; 

while  cbjchaser  o  NIL  Do 

begin 

cbj  chaser'' .  cbj '' .  hilite  (}$x>s ,  Ypos) ; 
cbjchaser  :=  cbj  chaser^,  next; 
end; 
end; 


Procedure  ActionContext(Xp<cs,Ypos:word) ; 

{ 

******■***********'******■***************■*'*********★*********************** 


*  * 

*  PURPOSE  * 

*  Asks  all  cbjects  that  are  associated  with  the  * 

*  context  that  is  on  the  tcp  of  the  context  stack  AND  whose  * 

*  'hot'  area  encloses  the  irput  x/y  coordinates  to  perform  * 

*  the  action  that  is  associated  with  themself s.  Each  * 

*  cbject's  ACTION  method  in  the  context  will  be  invoked.  * 


************************************************************x7r*******x** 

) 
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vaTf" 

obj  chaser:  ctlptr ; 
duniiry;bx)lean; 
begin 

cbj chaser  ;=  caontextlist^. element ''.controllist; 

vAiile  cbjchaser  o  NIL  Do 

begin 

dummy  :=  cb j chaser^. cbj''. action ()4x>s, Ypos ) ; 
dsjchaser  :=  c±)j chaser'. next; 
end; 
end; 

Procsidure  KeyActionCorrtextt J^Jos^Ypos*: word;*- )cey-;  integer)-; 

{ 

*************************************************************************** 


*  * 

*  PURPOSE  * 

*  Utility  routine  that  handles  all  kejdxiard  input  for  the  * 

*  on-screen  contipols.  Parses  out  the  key  command  to  the  * 

*  appropriate  control  c±>ject  by  asking  each  daject  v^iether  * 

*  the  iiput  j^/y  coordinates  are  within  their  'hot'  areas.  * 

*  Also  checks  for  the  tab/shifttab  and  esc  (i.e. ,  cancel  * 


*  current  context)  keys  and  performs  the  appropriate  action.  * 

************************************************************************ 

) 

var 

obj  chaser :  ctlptr ; 
dummy : boolean ; 

X,Y:  integer; 

XX, yy:  integer; 

begin 

CASE  key  OF  {  check  for  TAB  and  BackTab  and  any  other  keys  ) 

FWD_NEXr_OBJECr,  BHWD_NEXr_OBIECT: 
begin 

chj chaser  :=  tablist''. element^. controllist; 

IF  cbjchaser  o  NIL  THEN  {  make  sure  there  is  scmething  in  the  tab  list  } 
begin 

HidejOursor; 

{  put  on  the  first  element  of  the  list  in  case  there  is  nothing 
currently  hilited  or  in  case  we  get  to  the  end  of  the  list  } 

XX  ;=  cb j chaser^. cbj''.X-r<±)j chaser ^.cbj^. width  DIV  2; 
yy  :=  ob j chaser^. cbj^.Y-rcbj chaser''. cbj^.Hei(^t  DIV  2; 
vhile  cbjchaser  o  NIL  Do 

begin  {  find  the  currently  hili^ted  object  (  if  there  is  one  )  } 

{* 

IF  (obj  chaser'',  obj  ^.Hilited)  then 
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IF'  (obj chaser^. cbj^.Hilited)  OR  (cbjchaser'>'.cbj''.IsQn(J$)os>ypos);)  tlien 

CASE  OF 

FWDJCEXrjOBJECT: 

begin 

IF  (cbj chaser^. next  o  NIL)  IHEN 

begin  {  move  the  cursor  to  the  next  ctoject  } 

XX  :=  cbjchaser^.next'^.obj^.X+ 

cb j chaser^. next''. cbj^. width  DIV  2; 
yy  :=  cbjchaserr'.next^'.cbj^.Y+ 

objc*asei^.next^.cbj<'.Hei^t'  DIV  2; 
objdiaser  :=  NIL;  {  to  end  the  loop  } 
end; 
exx3; 

BKWD_NEXr_OBJECr: 

begin 

IF  (c±)j chaser''. prev  o  NIL)  IHEN 

begin  {  move  the  cursor  to  the  next  object  } 

XX  :=  cbjchaser^.prev''.cbj''.X+ 

obj chaser''. prev''.cbj^. width  DIV  2; 
yy  :=  cbj chaser''. prev''.cbj^.Y+ 

obj chaser^. prev''.cbj''. Height  DIV  2; 
cbjchaser  NIL;  {  to  end  the  locp  ) 
end 

ELSE  {  at  start  of  list,  go  to  end  ) 
begin 

vhile  cbjchaser''. next  o  NIL  DO 
cbjchaser  ;=  cbjchaser''.next; 

XX  :=  cbj chaser''. cbj''.X+ 

cb j chaser ^.cbj''. width  DIV  2; 
yy  ;=  cbj  chaser ''.obj''.Y+ 

cbj  chaser ''.cbj^.Hei^t  DIV  2; 

end; 

cbjchaser  :=  NIL; 
end; 

end;  {  CASE  )cey  of  ) 

IF  cbjchaser  <>  NIL  IHEN 

cbjchaser  ;=  cbj  chaser',  next; 
end;  {  while  cbjchaser  o  NIL  } 

Show_Ojrsor(xx,yy) ; 
end;  {  IF  cbjchaser  o  NIL  ) 
end; 

ELSE 

begin 

cbjchaser  :=  cx3ntextlist''.element''.controllist; 

vhile  cbjchaser  o  NIL  Do 

begin 

if  (cbjchaser''. cbj''. keyachion(}&X)s,Ypos, key) )  then 
begin 
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ge%cur:Soi3ffi:fX7Y)s; 

HiliteOonte}ct(X,Y) ; 
dunny  :=  cbjchaser^.c±)j^.action(X,Y) ; 
end; 

cbjdtiaser  ;=  obj chaser'. next; 
end; 
end; 

end;  {  CASE  3cey  } 
end; 

FCrrKd::ion-' TC^xsontext:  boolean'; 

{ 

*********jlf****itA******************************'************************** 


**  * 

*  PURPOSE  * 

*  Boolean  function  that  tells  you  whether  the  context  that  * 

*  you  are  interested  in  is  the  one  on  the  tcp  of  the  context  * 

*  stack.  * 


************************************************************************ 

} 

begin 

IF  contextlist''.nextconbext  o  NIL  IHEN 
TopContext  :=  FALSE 
ELSE 

TcpContext  :=  TRUE; 

end; 


Procedure  CancelContext; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Informs  all  objects  in  the  current  context  to  cancel  * 

*  themselfs  >*en  a  cancel  the  current  context  coitiniand  is  * 

*  issued.  * 


****************'*******************************************************'jt 

) 

var 

cbj  chaser ;  ctlptr ; 
begin 

obj chaser  :=  contextlist^. element''. controllist; 

vhile  cbjchaser  o  NIL  Do 

begin 

chjchaser'' .  cbj  ^ .  Carx::el ; 
c±)jchaser  :=  cbj  chaser  •'.next; 
end; 
end; 


Function  CurrentContext:  shortstring; 
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{ 

********* *************************************************************** 


*  * 

*  HJRPCSE  * 

*  Returns  the  name  of  the  current  context  (the  one  on  the  * 

*  top  of  the  context  stack.  * 


************************************************************************ 

} 

begin 

CurrentContext  :=  contextlist''.element''.name; 
end; 


Begin 

contextlist  :=  NIL; 
contextpool  :=  NIL; 
tablist  :=  NIL; 
tabpool  :=  NIL; 

End. 
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*  *■' 

*  IIROGRAM  NAME  -  Omega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evalxiation  * 

*  (PACE)  * 

*  WorJcstation  * 

*  * 

*  UNIT  NAME  -  Part  of^the  OCHCRDLS  Unit  * 

*  * 

★***********************************ifc***’^******************************* 
*  * 

* '  Tliis!-programv-vras,.ipr^3ared":by.^  * 

*'■  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Beading,  Massachusetts  01867  * 

*  •k 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  conpatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccsipatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  Dr0323-89-C-20008,  Thsk  Ord^  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (C»JSCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Contains  all  of  the  c±)ject,  constant  and  unit  variable  * 

*  declarations  for  the  controls  unit.  * 

*  * 


************************************************************************ j 

const 

{  vertical  and  horizontal  bar  contstants  ) 
logscale  =  1; 

linearscale  =  0 ; 

reverselogscale  =  -1; 

H_Barwidth  =  95; 

H_Earhei^t  =  10; 

V_Barwidth  =  15; 

V_Barhei(^t  =  129 ; 

Slidewidth  =  7 ; 

Slidehei<^t  =  7 ; 

arrcwwidth  =  10; 

arrcwheight  =  10; 

valuewidth  =  60; 

K_SlideLength  =  H_Barwidth  -  arrowwidth  -  arrcwwidth  -  Slidewidth; 
y_SlideIength  =  V_Earheight  -  arroi^.eight  -  arrcwheight  -  Slideheight; 
shorcstringlength  =  16; 
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editstrlengtii  =  19; 

(*  orientation  for  the  mutually  exclusive  buttons  *) 

(*  used  in  Controls. pas  for  conputing  the  slide  length  *) 

(*  if  a  generic  slide  bar  is  made,  this  wouldn't  be  necessary. . .  *) 

Horizontal  =  true; 

Vertical  =  false; 

(*  default  pixel  width  of  the  shadows  on  all  of  the  windows  *) 
WindowShadcwWidth  =  6; 


type 

shortstring  =  string  [shortstringlength] ; 
editstring  =  string  [editstrlength] ; 

Control  =  dDject 

X,y, Width, Hei^t;  integer; 

Color:word; 

Hilited:  Boolean; 

constructor  Init (InitX,  InitY,  InitWidth,  InitHei^t:  integer; 

Initcolorrword) ; 
procedure  Shew;  virtual; 
procedure  Hide;  virtual; 

function  Action (J5xDs,Ypos: word) :  boolean;  virtual; 

function  Is0n(}$5os,Ypos:word)  :  boolean;  virtual; 

function  IsHilited  ;  boolean;  virtual; 

procedure  SetHilite(Hilite_: boolean) ;  virtual; 

procedure  HiLite(}$)Cs,Ypos : word) ;  virtual; 

procedure  Cancel;  virtual; 

function  KeyAction(}ftx3s,Ypos:word;  key: integer)  :  boolean;  virtual; 

procedure  ChangeXY  (^ipos ,  Ypos :  word) ;  virtual ; 

end; 


ControlPtr  =  ■^Control; 

BorderedArea  =  object (Control) 

EorderColor:  word; 

BorderWidth:  integer; 

constructor  Init  (InitX,  InitY,  InitWidth,  InitHei<^t :  integer; 
Initcolor ,  InitBorderColor :  word ; 
InitBorderWidth; integer) ; 
procedure  Shew;  virtual; 
end; 


WindcwPtr  =  ^Window; 
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Window  =  object  (EorderedArea) 

(*‘^  BitImg;-&ixBitIing;  ''byj:e;  *)• 

Visible.-  ;  Boolean;:', 

shadowsize  :  integer; 

constructor  Init (InitX,  InitY,  InitWidth, InitKeight:  integer ; 
Initcolor ,  InitBorderColor;  word ; 
InitBorderWidth ,  InitShadowSize :  integer) ; 
procedure  Shew;  virtual; 
procedure  Hide;  virtual; 

end; 


Fi>cedControl  '  =  object  (Control) 

HiLiteColor:  word; 

ControlColor/HiliteGontrolGolor:-  word-;: 

constructor  Init-(InitXf.InitY,  InitWidth,  InitHeight:  integer; 

Initcolor ,  IriitHiLiteColbr^  InitControlColorrlnitHiliteControlColor :  word) ; 
procedure  HiLite(J^x3s,Ypos:word) ;  virtual; 
procedure  Show;  virtual; 
procedure  Hide;  virtual; 

function  Action ()$)os,Ypos: word) ; boolean;  virtual; 

end; 


Slider  =  object  (FixedControl) 

constructor  Init  (InitX,  InitY,  InitWidth,  InitHei^t :  integer; 

Initcolor,  InitHiLiteColor,  InitControlColor,  InitHiliteControlColor:  word) ; 
procedure  Moveato(}^xis,Ypos:word) ;  virtual; 
procedure  Show;  virtual; 
procedure  HiLite(Xpos,Ypos;word) ;  virtual; 

end; 


TextButton  =  cbject(FixedControl) 

Name  '  ;  shortstring; 

NameChanged  :  Boolean; 

HotKey  :  char; 

constructor  Init  (InitX,  InitY ,  InitWidth,  InitHeight, 

Initcolor,  InitHiLiteColor,  InitNameColor, 
InitHiliteNameColor ;  word ;  Ini tNane ;  shortstring ; 


Ini.’tHotKsyichsr)  * 


procedure 

procedure 

procedure 

function 

end; 


ChangeName  (NewName ;  shortstring) ;  virtual ; 
HiLite  (}^x;s ,  Ypos :  word) ;  virtual ; 
Shew;  virtual; 
KeyAction(>$os, Ypos; word;  key; integer) : boolean;  virtual; 


EditButton  =  object  (FixedConrrol) 
editstringlength  :  integer; 
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Text_String.  ;  staring; 

DisplayjString  :  editstring; 

CursorPosition, 
textoffset  ;  integer; 

ClearString  :  boolean; 

constructor  Init(InitX,InitY,InitWidth,InitHeight, 

Initcolor ,  InitHil  liteColor ,  InitNameColor , 
InitHilit^ameColor :  word ; 

Inititext :  string ;  InitCursorRjsition , 


InitTextOffSet:  integer; 

InitStringlength  :  integer; 
InitClearString  :  boolean) ; 

fuiKtion  Action (}$)osvYpos; word)  ;  boolean;  virtual; 

procedure  HiLite(}$ps‘;Y'pos;word) ;  virtual; 

procedure  Shew;  virtual; 

procedure  BeShew;  virtual; 

procedure  DisplayText(NewText: editstring) ;  virtual; 

procedure  Change_String  (NewText ;  string) ;  virtual  ; 

end; 


NumberButton  =  c±)ject(TextEutton) 

Value:  real  {longint); 

int,frac:  integer;  {  integer  and  fractional  part  of  the  button  } 
constructor  Init(IndtX,I]ru.tY,InitWidth,InitHeight, 

Initcolor,  IhitHiLiteColor,  InitNameColor,  InitHilit^ameColor:v  ord; 
InitValue:  real  ;InitInt,InitFrac:  integer) ; 
procedure  Shew;  virtual; 

function  Action (}$50s,Ypos: word) : boolean;  virtual; 
end; 

StatusButton  =  (±)ject(TextButton) 

Selected:  boolean; 

SelectedColor ,  SelectedNameColor ;  word ; 
constructor  Init(InitX,InitY,InitWidth,InitHei^t, 

Initcolor,  InitHiLiteColor,  InitSelectedColor , 

InitNameColor,  InitHiliteNameColor,  InitSelectedNameColor;  word; 
Initi^aitietshortstring) ; 
procedure  Shew;  virtual; 
procedure  Hilite(J^X!s,Ypos;word) ;  virtual; 
procedure  TumOn;  virtual; 
procedure  TumOff;  virtual; 
end; 

TextButtonSD  =  <±)ject(TextButton) 

construertor  Init  ( InitX ,  InitY ,  InitWidth ,  InitKeight , 

Initcolor,  InitHiLiteColor,  InitNameColor,  InitHiliteNameColor:word; 
InitName;  shortstring  ;IriitHotKey:  char) ; 
procedure  Shew;  virtual; 
procedure  Hilite(3&cs,Ypos:word) ;  virtual; 
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prTDceduTB  QiangeNaine (NewName: shortstring) ;  virtual; 
end^^ 

BditButtonSD  =  object  (EditBirL'ton) 

constructor  Init (InitX, InitY, InitWidth,  InitHei^t , 

Initcolor ,  InitHiLiteColor ,  InitNaroeColor , 
InitHiliteNameColortword; 

Init3'e>ct :  string;  InitCursorPosition, 
InitStringDsngth :  integer; 
InitClearStringiboolean) ; 

procedure  Shew;  virtual; 

procedure  Hilite(:^5ps,Ypcs;wDrd).;  virtual; 

end; 


UpArrewButton- =  object  (FixedCdnferdl) 

constructor-  Ihit  (IhitX)  IhitY,  InitWidth,  IhitHei^t;  integer; 

Initcolor,  InitHiLiteColor,  InitControlColor,  InitHiliteControlColor ; word)  ; 
procedure  Show;  virtual; 
procedure  Hilite(Ypos,Ypos:wDrd) ;  virtual; 
end; 


EJewnArrewButton  =  cbject(FixedControl) 

constructor  Init  ( Initx ,  InitY ,  InitWidth,  InitHeight :  integer ; 

Initcolor,  InitHiLi,teColor, InitControlColor,  InitHiliteControlColor: word) ; 
procedure  Shew;  virtual; 
procedure  Hilite(}$)os,  Ypos: word) ; virtual; 
end; 


leftArrowButton  «  object (FixedControl) 

constructor  Init  ( InitX ,  InitY ,  InitWidth ,  InitHeight :  integer ; 

Initcolor,  InitHiLiteColor,  InitControlColor,  InitHiliteControlColor: word) ; 
procedure  Show;  virtual; 
procedure  Hilite(Xpos,Ypos:word) ;  virtual; 
end; 

RL^tArrewEutton  =  object  (FixedControl) 

constructor  Init  ( InitX ,  InitY ,  InitWidth ,  InitHeight ;  integer ; 

Initcolor,  InitHiLiteColor, InitControlColor,  InitHiliteControlColor: word) ; 
procedure  Shew;  virtual; 
procedure  Hilite{^^)Os,Ypcs:word) ;  virtual; 
end; 


KorizontalSlideBar  =  object  (FixedControl) 
Name, Units;  shortstring; 

Hiliim,  LoLim,  Increment :  real  ; 
AccelFactor :  real ; 

Accel: integer; 

Left : LeftArrowButton ; 
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Ri^t :  Ri^tArrcwButton ; 

SlideBar:Slider; 

Value :  NumberButton ; 

(xnstructor  Init  (InitX,  InitY ,  InitColor ,  InitHiliteColor , 

InitControlColor ,  InitHiliteControlColor :  word  ; 
InitLoIim,  InitHiLim,  Initinc;  real  ; 

InitAccel :  integer ;  Ini  tName ,  InitUnits :  ^ortstring ; 
InitInt,InitFrac:  integer) ; 
procedure  Hilite(}^X5S,Ypos:word) ;  virtual-; 
procedure  Shew;  virtual; 

function  Action (JQx5s,Ypos: word) : boolean;  virtual; 
end; 


VerticalSlideBar  ==  object  (FixedControl) 
Value,HiLiim,IoLim, Increment  :  real; 

AccelFactor  :  real; 


Accel 

Up 

Down 

SlideBar 


integer; 
UpArrewButton; 
DewnArrewButton ; 
Slider; 


constructor 


procedure 

procedure 

function 

end; 


Init  (InitX,  InitY,  InitColor ,  InitHiliteColor, 

InitControlColor,  InitHiliteControlColor;  word ; 
InitloLim,  InitHiLim,  Initinc :  real ;  InitAccel :  integer) ; 
Hilite  (3^X36 ,  Ypos ; word) ;  virtual ; 

Show;  virtual; 

Action(}(^30s,Ypos;wDrd)  :boolean;  virtual; 


var 

WindowImageNumber  :  byte;  (*  the  image  number  currently  being  stored  *) 
Biting,  AuxBitImg  :  ^byte; 

procedure  GetImageFileName(var  f:File;  ImageNumber  :  byte); 
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unit^t-Goritipls-; 

^**************************************************************^!>c**i^*,*ik' 


*  * 

*  PROGRAM  NAME  -  Omega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evalxiation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  Ul^NAME.'-OCNIROIS-  * 

*  * 

************************V»!****;/^Jk*****************“************************ 
*  * 

This!*prcigraro'?vras.«preparedv'fcy-  * 

*  * 

*  Ihe  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  coipatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimum  of-  640K  of  main  * 

*  memory  and  an  EGA  or  ccnpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (WSCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  This  unit  contains  the  object  declarations  and  methods  * 

*  for  all  of  the  basic  on-screen  control  and  display  * 

*  objects.  * 

*  * 


************************************************************************) 

interface 

uses  Graph,  Crt,  cursrcbj,  Erricg; 

{$I  contl.pas  ) 

inplementation 

const 
CR  =  $0D; 

ESC  =  $1B; 

DEL  =  $08; 
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Control's  method  inplementations:  } 

- } 

constructor  Control .  Init (InitX,  InitY, InitWidth,  InitHei^t;  integer; 
Initcolorrword)  ; 

{ 


* 

*  PURPOSE  * 

*  Object  definition  for  the  'grandadcfy'  object  in  the  PACE  * 

*  object  heirarchy.  Has  sane- basic  attributes  that  are  * 

*  generic  bo  all  of  the-  objects  used  in  PACE.  * 


************************************************************************* 

} 

begin 

X  :=  InitX; 

Y  :=  InitY; 

Width  :=  InitWidth; 

Hei^t  :=  InitHei<^t; 

Color  ;=  Initcolor; 
end; 


procedure  Control. Shew; 

{ 

ii*itit**************ii**it****'k*******it***itit***ifk***it'k*******-k-k****'k-k**it**** 


*  * 

*  PURPOSE  * 

*  Method  to  fill  the  area  oca:53ied  by  a  generic  on-screen  * 

*  control  with  the  objects  declared  color.  * 


************************************************************************ 

) 

begin 

setfillstyle(solidf ill, color) ; 
bar  rx, Y , X+Width, Y+Height) ; 
end; 


procedure  Control. Hide; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Method  to  remove  a  generic  object  from  the  display.  * 

*  Declared  here  as  a  placeholder  to  be  filled  in  by  more  * 

*  specific  object  declarations.  * 
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)  '  ' 

begin 

end; 


procedure  Control.Hilite(}{pos,ypos:Vford) ; 

{ 

**********************:*fifc**tfc***********4r:fc^********:fc****:Ar******T^t********** 


*  * 

*  rURPOSE-  *' 

* '  Method'  tG-'hi^i^ib-'-.a'-gen^ie-  object  on- -the»^display»  * 

*'  Declaredihere'as;;a,.plac^older~.to  be'‘.fille<i''in.‘by*'mf3re  ■  * 

*  specific  object  declarations.  * 


**************************************************************************** 

} 

begin 

end; 


(*  ><><><><><><><><0><C><><>0<><><><><><>0<><0<><><><><><><><><><><><><><><><  *) 

function  Control. Action ()^XDs,Ypos;word)  :boolean; 

{ 

************************************************************************ 


*  * 

*  HJRPOSE  * 

*  Method  to  activate  generic  object  based  on  v^ether  the  user* 

*  is  currently  pointing  at  the  object  on  the  display.  * 

*  Declared  here  as  a  placeholder  to  be  filled  in  by  more  * 

*  specific  object  declarations.  * 


*************************************************************************** 

) 

begin 

IF  CKpos  >=  X)  AND  {y:pos  <  XWidth)  AND  (Ypcs  >=  Y)  AND  (Ypos  <  Y+Hei^t)  THEN 
action  :=  TKJE 
EtSE 

action  ;=  FAISE; 

end; 


*) 


function  Control. Is0n(}&x3s, Ypostword)  :boolean; 

{ 

■***■*******•****•**■*****•*•**■**•*■****■*•*•*****•*■**•**•****•******■****•************■*** 


*  * 

*  RJKPOSE  * 

*  Indicates  vbether  the  cursor  is  on  the  object.  * 

*  * 
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************************************************************************ 

) 

begin 

IsCJn  :=  ODntax5l.Actlon(J$x)s,ypos) ; 
end; 


*) 


function  Control. IsHilitedrboolean; 

{ 

************************************************************************** 


*  * 

*  PURPOSE  * 

*  Indicates-  v^ether  the-  object  is  currently  hi^^li^ted.  * 

*  X 


★  ★★Tut********************-******************-*******************-*********** 

} 

begin 

IsHilited  :=  Hilited; 
end; 


procedure  Control. SetHilite(Hilite_:boolean) ; 

{ 

******>***************************************************************** 


*  * 

*  PURPOSE  * 

*  Forces  the  object^s  highlight  indicator  on.  * 

*  * 


*'*****■*■*■***★★**'********★********'*■*********★★********★******★**★**★***'*** 

) 

begin 

Hilited  :=  Hilite_; 
end; 


procedure  Control. Cancel; 

{ 

*************************-*******'**************-**X***-**************-***'*** 


*  * 

*  PURPOSE  * 

*  Ifethod  to  deactivate  generic  object  * 

*  Declared  here  as  a  placeholder  to  be  filled  in  by  more  * 

*  specific  object  declarations.  * 


*:^************'**x**'***'**'****-****'x*****-jt****-*  ■*****:!?  jtx**-**************-***-* 
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begin’ 

end; 


function  Control. FeyAction(}$xJS,Ypos:word;  keyiinteger)  :boolean; 

{ 

*******************************■**************<<************************** 


*  * 
FURK3SE'  * 

*  Method-  to  activate  generic  object  based  on  vfcether  the  user* 

*■  is-  currently  pointing  at  the  object  on.  the'.display.  * 

*  Decl^redrhere  asra  placeholder  to  be .  filled,  in  hy  more  * 

**  sp^ific*'cbjeGt'f;declarationss  * " 


**********★*****★*****★★***********★********★■**★****★»'•****************** 

) 

begin 

KeyAction  :=  FALSE; 
end; 


(*  ><><><><><><><><><CK><><><><><><><><><><><>0K><><><>0<><><><><><><><><><  *) 


procedure  Control .  ChangeXy  (3^305 ,  Ypos ; word) ; 

{ 

************************************************************************ 


* 

* 

* 

* 


* 

PURPOSE  * 

Method  to  change  the  Vy/  screen  location  Where  the  object  * 
will  be  displayed.  * 

************************************************************************ 

} 

begin 
X  ;=  Xpos; 

Y  ;=  Ypos; 
end; 

constructor  BorderedArea .  Init  ( InitX ,  InitY ,  InitWidth ,  InitKeight ;  integer ; 

Initcolor ,  InitBorderColor ;  word ; 

InitBorderWidth:  integer) ; 

{ 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Method  to  initialize  a  bordered  area  on  the  screen.  Builds  * 

*  on  the  control  object.  * 

*******************************»:**************************************** 
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) 

begin 

Control .  Init (InitX,  InitY,  InitWidth,  InitHei^t ,  Initcolor) ; 
BorderColor  :=  InitBorderColor; 

BorderWidth  :=  InitBorderWidth; 
end; 


procedure  BorderedArea.Shcw; 

{ 

************************************************************************ 
*  * 

*  HJRPOSE  * 

*  Method  to  display  a  bordered  area  on  the  screen.  Uses  * 

*  the  the  control  object's  shew. 
************************************************************************ 

) 

var 

i,  XX,  yy:  integer; 
begin 

get_cursorXY (xx , yy ) ; 

HidejCursor; 

Control.  Shew; 
setcolor  (BorderColor) ; 
for  i  ;=  1  to  borderwidth  do 
rectangle  (X+i ,  Y->i ,  X+Width-i ,  Y+height-i ) ; 
shew__cursor(xx,yy) ; 
end; 


(*  ><><><><><><><e><><><><><><><><><>c><><><><><><><><><><><><><><><><><><><><  *) 

constructor  Window .  Init  ( InitX ,  InitY ,  InitWidth ,  InitHeight ;  integer ; 

Initcolor ,  InitBorderColor :  word ; 

InitBorderWidth,  InitShadewSize  ;  integer) ; 

{ 

************************************************************************ 


*  * 

*  HJRPOSE  ■  * 

*  Method  to  initialize  a  display  window  cbject.  A  windew  is  * 

*  a  bordered  cbject  that  saves  vhat  is  underneath  for  later  * 

*  display.  * 


************************************************************************ 

) 


begin 

shadewsize  :=  InitShadewSize; 

borderedarea .  Init  (InitX,  InitY,  InitWidth,  InitHeight,  Initcolor, 
InitBorderColor,  InitBorderWidth) ; 
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end-ir 


procedure  GetIinageFileNaine(var  f  :File;  ImageNumber  :  byte)  ; 

{ 

************************************************************************ 
*  * 

*  HJRPOSE  * 

*  Utility  routine  x:ised  by  windcwvshcw,  to  store-^display  data  * 

*  so  that  the  window  can  be  removed  and  vtot  was  there  before* 

*  will  re^appear*  SequenfeLal-ly  stores-^  image"- files-,  to  disk  for* 

*  later-retrieval.'  * ' 

**************************.***************.******************'**■*********** 


} 

var 

filename, 
ext  :  string; 


begin 

str(ImageNuinber,  ext) ; 

if  (ImageNumber  <  10)  then 
ext  :=  '00'  +  ext; 

if  (ImageNumber  >=10)  and  (ImageNumber  <  100)  then 
ext  ;=  '0'  +  ext; 


filename  :=  'IMS. '+  ext; 
Assign  ( f ,  filename) ; 


end; 


(*  ><><><><><><><><><><><><><><><><><><><><><><><><><><><><XXXXXXXXX  *) 


procedure  Window.  Show; 

{ 

************************************************************************ 


* 

PURPOSE  * 

Method  that  saves  vtot  will  be  overlaid  by  the  window  in  * 
question  and  then  displays  the  window  area  (essentially  a  * 
bordered  area.  If  necessary,  breaks  up  the  underlying  area  * 
into  pieces  that  are  small  enough  to  hold  in  the  remaining  * 
memory  before  storing  them  to  disk.  * 

************************************************************************ 


* 

* 

* 

* 

* 

* 

* 


var 
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Si2e> 

iTuniwritten  :word; 
stl,st2  :  string; 

XX, yy,i;  integer; 
f  ;  file; 

begin 

get_cursorxy(xx,yy) ; 
hidejcursor; 

Size  :=  iinagesize(X,Y,X+Width+shadcwsize,Y+Hei^t+shadcwsi2e) ; 

{  Imagesize  returns  0  if  >  64K  ) 

{  IF  imagesize(X,Y,X+Width+shadcwsize,Y+Hei^t+shadcwsize)  <>  0  THEN) 

IF  (Size  o  0)  AND  (Size  <  $4000)  THEN' 
begin 

inc(WindcwIinageNumber) ; 

GetIinageFileNaine(f,WindcwIinageNuniber) ; 

if  maxavail  >  Size  then 

begin 

gettnem(BitIing,Size) ; 

getimage (X, Y, X+width+shadowsize,  Y+Height+shadowsize,  Bitimg'' ) ; 

Rewrite (f,l) ; 

BlockWrite(f,BitIing'',Size,NiniiWritten) ; 

if  (Size  o  NuntWritten)  then 

begin 

str(Size,Stl) ; 
str(NuirWritten,St2) ; 

lDg_Error('Si2e  =  '4stl+'  NuirWritten  =  '+st2+'  IN  Windcw.Shcw') ; 
end; 

freemem(BitImg,Size) ; 

Close(f) ; 
end 
else 
begin 

star  (Size,  Stl)  ; 

IjC!g_Erxor('Not  enom^  memory  to  store  v^ole  window  image,  size  =  '-i-stl) ; 
end; 
end 
else 

for  i  :=  3  dcwnto  0  do 
begin 

inc  (WindcwImageNumber) ; 

GetlmageFileName(f,WindcwImageNumber) ; 

Size  :=  imagesize  (X,Y+i*(Hei(^t-fshadowsi2e)DIV  4, 

X+Width+shadcwsi2e,Y+(i+l)*(Hei^t+shadcwsize)DIV  4) ; 
if  maxavail  >  Size  then 
begin 

getmem(AuxBitImg,Si2e) ; 

getimage  (X,  Y+i*  (Hei^t+shadowsize)  DIV  4 , 
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X4Widti5i«6ad^i2e,,y-k(i+l)*{Hei^t-t:^:a(aciwsi2e),p3W  ; 

Rewrite (f,l) 

BlocWfrite(f,AuxBit]Qng'',Si2e,Nu]tKrit^  ; 

if  (Size  o  NuirWritten)  then 

begin 

str(Size,Stl) ; 

str(NunWritten,St2) ; 

Log_Error(^Si2e  =  '+stl+'  NumWritten  =  '+st2+'  IN  Window. Show')  ? 
end; 

f feemem  (ALKBitlmg/Size)-; 
close (f) ; 
end- 
else- 
b^ih.‘ 

str(Size,Stl) ; 

Iiog_Error('Not  enou^  memory  to  store  half  window  image,  size  =  '+stl)  ; 
end; 
end; 


inc(WindowImageNuniber) ; 

GetImageFileName(f,WindowimageNumber) ; 

Size  ;=  imagesize(X,Y,X4Width+shadowsize,  (Y+Hei^t+shadowsize)DIV  2); 

if  maxavail  >  Size  then 

begin 

getmem(BitIing,Size) ; 

getimage(X,Y,X+Widthfshadowsize,  (Y+Height+shadowsize) DIV  2, Biting^) ; 
Rewrite(f,l) ; 

Bloc3<Write(f,BitImg'',Size,NunWritten)  ; 

if  (Size  o  NunWritten)  then 

begin 

str(Size,Stl) ; 
str  (NumWritten,  St2) ; 

LDg_Error('Size  =  '+stl+'  NuirWritten  =  '+st2+'  IN  Window.Shov?') ; 
end; 

freemem(BitImg,Size) ; 
close  (f) ; 
end 
else 
begin 

LDg_Error('Not  enou^  memory  to  store  window  image') ; 
end; 
end; 

*) 


BorderedArea .  show ; 

if  shadowsize  >  0  then  begin 
setfillstyle{solidf ill, black)  ; 
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bar  (X+Widthfl ,  Y+shadawsize ,  X4Width+shadcwsi2e ,  Y+Hei^t+shadcwsize) ; 
bar  (X+shadowsize ,  Y+Hei^t+1 ,  X+Width,  Y+Hei^t+shadow.-;ize) ; 
end; 


shciw_cursor(xx,yy)  ; 
visible  :=  TRUE; 
end; 


procedure  Window. Hide; 

{ 

************************************************************************* 


* 

* 

★ 

* 

* 

* 

* 


* 

R3RP0SE  * 

Method  that  removes  the  windcw  display  and  replaces  it  with* 
vtot  was  there  before.  * 

If  necessary,  brealcs  up  the  underlying  area  * 

into  pieces  that  are  small  enough  to  hold  in  the  remaining  * 
memory  before  getting  them  from  disk.  •  * 

************************************************************************ 


var 

stl,st2  :  string; 

Size,Size2, 

NumRead  ;  word; 

XX, yy,i: integer; 
f  :  File; 

begin 

IF  visible  THEN 
BEGIN 

get_cursorxy(xx,yy) ; 
hide_cursor; 

Size  ;=  imagesize(X,Y,X4Width+shadowsize,Y+Hei^t-fshadowsize) ; 

{  Imagesize  returns  0  if  >  64K  } 

{  IF  imagesize (X,Y,X+Width+shadowsize,y+Hei^t-rshadowsize)  o  0  THEN) 

IF  (Size  o  0)  AND  (Size  <  $4000)  THEN 
begin 

GetImageFileNaine  ( f ,  WindowImageNumber )  ; 

if  maxavail  >  Size  then 

begin 

getmem(BitIiig,Size) ; 

Reset (f,l) ; 

BlodcRead  ( f ,  Bitlmg^ ,  Size ,  NumRead) ; 
if  (Size  <>  NumRead)  then 
begin 

str(Size,Stl) ; 
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str  (NfeiR^a‘Jst2'):‘; ' 

L3g_Error ( 'Size  =  '+stl+'  NumRead  =  '+st2+'  IN  Windcw-Hide') ; 
end? 

Close (f) ; 

putimage  (X,  Y ,  Biting'' ,  CcpyPut) ; 
freemem(BitImg,Size) ; 
decCWindcwImageNurtiber) ; 
end 
else 
begin 

Log_Error('Not  enou^  memory  to  store" vindcw  image') ; 
end? 
end 
elsef^ 

for  i  :=  0  to  3  do 
begin 

(* 

GetImageFileName  ( f ,  WindcwImageNumber ) ; 

Size2  :=  imagesize(X,y,X+Width+shadcwsize,  (y+Hei^t+shadowsize)DIV  2)? 

if  maxavail  >  Size2  then 

begin 

getmem (Biting, Size2) ; 

Reset(f,l) ; 

BlockKead(f, Biting^, Size2, NumRead) ; 
if  (Size2  o  NumRead)  then 
b^in 

str(Size2,Stl) ; 
str (NumRead, St2) ; 

Iog_Error('Size2  =  '+stl+'  NumRead  =  '+st2+'  IN  Window.Hide') ; 
end? 

dec(WindowImageNumber)  ? 
close (f) ? 

putimage (X,  Y,  Biting'' , CopyPut)  ? 
freemem(BitIng,Size2)  ? 
end 
else 
begin 

IjDg_Erxor('Not  enough  memory  to  store  window  image')  ? 
end? 

*) 

GetImageFileName (f,WindowImageNumber)  ? 

Size  :=  imagesize(X,y+i*(Hei^t+shadcwsize)DIV  4, 

X+Width+shadowsize,  Y+  ( i+1)  *  (Hei^t+shadcwsize)  DIV  4 ) ; 
if  maxavail  >  Size  then 
begin 

getmem (AuxBitIng,  Size)  ? 

Reset (f,l) ; 

BlockRead(f, AuxBitIng^, Size, NumRead)  ? 
if  (Size  o  NumRead)  then 
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begin 

str(Si2e,Stl) ; 

stx{NumRead,St2) ; 

LDg_Error('Si2e  =  ^+stl+'  NumReaa  =  '+st24-'  IN  Windcw.Hide') ; 
end; 

dec(WindowImageNuiiiber) ; 

putlmage  (X,  Y+i*  (Hei^t+shadcwsize)  DIV  4 ,  AuxBitlmg^ ,  Cc^yPut) ; 
freemen (ALn£BitImg,Si2e) ; 
close (f) ; 
end- 
else 
begin 

Icg_ErTor('Not  enoucfi  memory  to  store  window-  image.') ; 
end; 
end; 


shcw_cursor(xx,yy) ; 
visible  ;=  FALSE ; 
END; 

end; 


constructor  FixedControl .  Init  (InitX,  InitY,  InitWidth,  Ini'tHei^t :  integer; 

Initcolor ,  InitHiLiteColor ,  InitControlCoi  or,  InitHiliteControlColor : word) ; 

{ 

*******V'****^<*************:k******************illr************************** 

*  * 

*  HJRPOSE  .  * 

*  Object  declaration  for  a  )dnd  of  control  that  has  an  action* 

*  associated  with  it  (e.g.,  an  on-screen  control).  * 

************************************************************************* 

) 

begin 

Control .  Init  (InitX,  InitY ,  InitWidth,  InitHeight ,  InitColor) ; 

Control.  Show; 

HiliteColor  :=  InitHiliteColor; 

ControlColor  :=  InitControlColor; 

HiliteControlColor  ;=  InitHiliteControlColor; 

Hilited  ;=  FAISE; 
end; 


*) 


procedure  FixedControl. Shew; 

{ 

*  * 
*  HJRPOSE 


* 
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*-  Me^oda±©r^displa$;ing;.  a.  fix^rctijeG±im.t]3es.sei^6enK.  * 

************************************************************************ 

) 

Var 

xx,yy:  integer; 
begin 
end; 


*) 


procedure  FixedControl.Hide; 

{ 

************************^************************************5*i***»****** 
*  * 

*  HJRPOSE  * 

*  Method  for  removing  a  fixed  object  from  the  screen  * 

**********************************************************i»t************* 

) 

begin 

end; 


(*  ><><><><>0<><><>0<><><>0<><><><><><><><><><><><><><><><><><><><><><><>^  *) 

procedure  FixedContxol.Hilite(5$)OS,YPos;word) ; 

( 

★  * 

*  HJRPOSE  * 

*  Method  for  hi^ighting  a  fixed  object.  * 

ilr**'******'**************'************************************************'»c 

} 

begin 

end; 


function  FixedControl. Action (}toas,Ypos: word) : boolean; 

{ 

itici:icieicicici(iciieititicifififrk:kici:iciti:iticieici^icicieitieiticiciti(itieitici(it'kicieieic'k'k'k'kicicicic'kici!ie'k\^iti(ieicieicicic 
*  * 

*  HJRPOSE  * 

*  Action  method  for  a  fixed  object.  * 

**★*************->**************■**  ************'****x*****‘****:»tx*********** 

} 

begin 

IF  Hilited  IHEN 
Action  ;=  TE^ 

ELSE 

Action  :=  FALSE; 
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end; 


constructor  Slider.  Init (InitX,  InitY,  Initwidth,  InitHei^t:  integer; 

Initcolor ,  InitHiLiteColor ,  InitControlColor ,  InitHiliteControlColor  :vrord) 

{ 

**************************************************************************** 

*  * 

*  PURPOSE  * 

*  Ctoject  intialization  for  the  little  slider  button  on  slide  * 

*  type  controls. 

★★★★★A************************************************* ***************** 

} 

begin 

FixedControl .  Init  ( InitX ,  InitY ,  Initwidth ,  InitHeight , 

Initcolor,  InitHiLiteColor,  InitControlColor,  InitHiliteControlColor) ; 

end; 


(*  ><><><><><><><><><><><><><>o<><><><><><><><><><><><><><><><><><><><><><><  *) 

Procedure  Slider. Shew; 

{ 

************************************************************************ 

*  * 

*  PURPOSE  * 

*  Ctoject  method  for  displaying  little  slider  button  on  slide  * 

*  type  controls. 

************************************************************************ 

) 

Var 

x}c,yy:  integer; 
begin 

Get_CursorXY(xx,yy)  ; 
hide_cursor; 

setfillstyle(solidf ill, color) ; 
bar(X,Y,X4Width,Y+Hei^t)  ; 
shcw_cursor(xx,yy) ; 
end; 


*) 


procedure  Slider.Hilite(}^>os,YPcs;word) ; 

{ 


*  * 

*  PURPOSE  * 

*  C^ject  method  for  hi^ili^ting  the  little  slider  button  * 

*  on  slide  type  conrrols.  * 
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***3r*****W*******'****1«r*W**|fc'******:/f***jfE*#*****"*'*'***Jt****ii#%^.* 

} 

begin 

IF  (X^JCS  >=  X)  AND  (}$»s  <  X+Width)  AND  (Ypos  >=  Y)  AND  (Ypos  <  Y+Hei^t)  THEN 
begin 

IF  NOT  Hilited  THEN 
begin 

hide__cursor; 

Hilited  :=  TRUE; 

setf illstyle  ( solidf  ill ,  hilitecolor ) ; 
bar(X,Y,X4«idth,Y+Height)  ; 
shcwjcursor  (Jtops ,  Ypos)-.; 
end 
end*; 

ELSE 

IF  Hilited  THEN 
begin 

hilited  :=  EAISE; 

Shew; 

end; 

end; 


Procedure  Slider,MoveTo(J$os,Ypos;word) ; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Ctoject  methed  for  moving  the  little  slider  button  * 

*  on  slide  type  controls,  * 


************************************************************************ 

} 

begin 

Shew; 

setfillstyle(solidfill,controlcolor) ; 
bar(X,Y,X+Width,Y+Height)  ; 

X  ;=  ^(pos; 

Y  :=  Ypes; 

IF  Hilited  THEN  BEGIN 

setf  illstyle  (solidf  ill,  hilitecolor)  ; 
bar(X,Y,X+Width,Y+Height) ; 

END 

ELSE 

Shew; 

end; 


F-62 


File  Name:  OCMKDIS.PAS 


constructor  TextButton.  Init  (InitX,  InitY ,  InitWidth,  InirHei^t , 

Initcolor,  InitHiLiteColor,  InitNameColor ,  InitHiliteNameColorrvord; 
InitName:  shortstring  jlnitHotKey:  char)  ; 

{ 


*  * 

*  HJRPOSE  * 

*  C^ject  initialization  for  a  ccasnnand  button  that  has  a  label* 

*  on  it.  * 

************************************************************************ 


) 

begin 

FixedControl .  Init  (InitX,  InitY,  InitWidth,  InitHeight, 

Initcolor ,  InitHiLiteColor,  InitNameColor,  InitHiliteNameColor) ; 
Name  :=  InitName; 

NameQianged  :=  FALSE; 

HotKey  :=  InitHotKey; 
end; 


(*  ><><><>c<><><>o<><><><><><><><><><><><><><><><><><><><><><><><><><><><><  *) 

function  HotKsyPosition  (Name; shortstring;  var  )oey:char)  :  integer; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Utility  function  for  finding  the  location  of  the  letter  * 

*  that  corresponds  to  the  hotkey  for  the  text  button.  * 


************************************************************************ 

} 

var 

position;  integer; 
found  ;  boolean; 

begin 

position  :=  1; 
r^)eat 

found  ;=  (key  =  Name  [position]) ; 
if  not(found)  then 
position  ;=  position  +  1; 
until  (found)  or  (position  >  shortstringlength) ; 

if  not(found)  and  (key  o  chr(O))  then 
begin 

Log_Error  ('HccKey  charaoter  ('-rkey+')  not  found  in  Texc&itton  Name  ('-f- 
Namer')'  ); 
key  ;=  chr(O)  ; 
position  :=  0; 
end; 
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HotK^Positdon;::  - -positiom- 
end; 


procedure  TextButton.Shcw; 

{ 

*  * 

*  PURPOSE  * 

*  Method  to  display  the  text  button  on  the-  sereen-.  * 

************************************************************************ 

} 

Var 

XX ,  yy ,  xl ,  yl ,  x2 ,  y2 ,  pos ,  titp :  integer ; 
begin 

Get_CursorX!if  ( xx ,  yy ) ; 
hide_cursor; 
x2  :=  X+Width; 
y2  :=  y+Hei^t; 

if  (hotkey  =  chr(O))  then  begin 
setf illstyle  ( solidf ill ,  color) ; 
bar(X,Y,X-Width,Y+Height)  ; 
setcolor(Controlcolor) ; 
settextjustify(cenbertext,centertext) ; 
outtextJ^(X+Width  DIV  2,Y  +  Height  DIV  2  +  l,name) ; 
end 

else  begin 

xl  :=  X  +  (Width  DIV  2  -  TextWidth(Naine)  DIV  2) ; 

yl  ;=  y  +  (Hei^t  DIV  2  -  TextHei^t(Name)  DIV  2) ; 

setfillstyle( solidf ill, color) ; 

bar(X,f,X2,Y2); 

setcolor(Controlcolor) ; 

settextjustify(lefttext,tcprtaxt) ; 

outtextxy(Xl,  Yl,  Name) ; 

pos  :=  HotKeyPositicii  (Name, hotkey) ; 

tirp  :=  textwidth  (hotkey) ; 

line(xl  +  taro* (pos  -  1)“1,  yl+textheight (hotkey)  {y2~4}, 
xl  +  tnp*pos-l,  yl+taxthei^t (hotkey)  {y2-4)); 

end; 

rectangle (X,Y,X-fWidth,Y+Hei(^t) ; 
shcw_cursor(xx,yy) ; 

end; 


procedure  TextButtcn .  QiangeName  (NewName :  shortstring) ; 

{ 

******************'*-jc**************:«:*****'*********'*'****ii:***'x*******x***'** 
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*  * 

*  PURPOSE  * 

*  Methcjd  to  change  the  name  of  the  text  button  * 

************************************************************************ 


} 

begin 

IF  Hilited  IHEN 

setcolor  (HiliteColor) 
else. 

setcolor  (color) ; 

settextjustify(centertext,centertext) ; 
outtextxy(X4Wicith  DIV  2,Y  +  Hei^t  DIV  2  +  l,name) ; 
Name  :=  newname; 

IF  Hilited  IHEN 

setcolor  (HiliteControlColor) 
else 

setcolor (Controlcolor) ; 
settextjiastify(centertext,centertext) ; 
outtextxy(X4Width  DIV  2,Y  +  Height  DIV  2  +  l,name)  ; 
NameChanged  :=  TKJE; 
end; 


procedure  TextButton.Hilite(ax)S,Vpos:word) ; 

{ 

************************************************************************ 

*  * 

*  PURPOSE  * 

*  Method  to  hi^i^t  a  text  button  when  the  cursor  is  on  it.* 
************************************************************************ 

) 

var 

xl ,  yl ,  x2 ,  y2 ,  pcs ,  tirp :  integer ; 
begin 

IF  >=  X)  AND  (Xpos  <  x-width)  AND  (Ypos  >=  Y)  AND  (Ypos  <  Y+Height)  THEN 

BEGIN 

IF  NOT  Hilited  THEN 
begin 

hide_cursor; 

Hilited  :=  TRJE; 
x2  :=  X+Width; 
y2  :=  Y+Hei^t; 

if  (hottey  =  chr(O))  then  begin 
setfillstyle( solid-ill, hilitecolor) ; 
bar(X,Y,X-Width,Y+Hei^t)  ; 
setcolor  (hiliteControlcolor) ; 
settextjustify(centertext,centertext) ; 
outtextoQ^(X+Width  DIV  2,Y  +  Height  DIV  2  +  l,name) ; 
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end-- 

else  begin 

xl  :=  X  +  (Width  DIV  2  -  TextWidth(Naine)  DIV  2)  ; 

yl  :=  y  +  (Height  DIV  2  -  TextHeight(NainB)  DIV2); 

setfillstyle(solidfill,hilitecolor) ; 

bar(X,y,X2,y2)  ; 

setcolor(HiliteContrDlcx)lor) ; 

settextjustify(lefttext,tq3text) ; 

cxittextxy(Xl,  Yl,  Name) ; 

iposv.:^  HctKleyPosition(N^>hot3<ey) ; 

tnp  :=  textwidth (hotkey) ; 

line(xl  +  tnp*(poS'^-  1)“1,  yl+texthei<^t (hotkey)  {y2-4), 
xl  +  tn:p*pos-l,  yl+texthei^Tt (hotkey)  {y2-4)); 

end,v 

rectangle(X,Y,X4Width,y+Hei^t) ; 
sh(>(_cursor()$)os,Ypos)  ; 
end; 

END 

ELSE 

IF  HiLited  IHEN 
begin 

hilited  ;=  FALSE; 

Shew; 

end; 


end; 


(*  ><><C><><>0<><><><><><><><><><><>0<><><><><><><><><><><0><><><><><><><><><  *) 

function  TextButton.KeyAction(5$»s,Ypos;word;  key;  integer) : boolean; 

{ 

*****llt********************************************************X**'******* 


*  * 

*  HJRPOSE  * 

*  Method  to  invoke  the  associated  action  vhen  the  user  * 

*  selects  the  text  button.  * 


************************************************************************ 

) 

var 

duininy,checkit  :  boolean; 
teap, 

Ickey, 

uckey  :  integer; 
begin 

KeyAction  :=  false; 

if  (HotKey  o  dir(O))  then 

begin 

checkit  :=  FALSE; 
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if  (]cey  >=  65)  and  (tey  <=  90)  then  {  between  a  . .  2  } 
begin 

IcJci^  :=  key  +  32; 
uckey  :=  key; 
ciieckit  :=  IHJE; 
end 

else  if  (key  >=  97)  and  (key  <=  122)  then  {  between  A  . .  Z  ) 
begin 

Ickey  :=  key; 
uckey  ;=  key  -  32; 
ciieckit  :=  TRUE; 
end; 

tenp  :=  ord(HcftKey) ; 
if  dieckit  AND  ( 

(teitp  =  Ickey)  or 
(tenp  =  uckey)  or 
(tenp  =  key) )  then 
begin 

Hide_Cursor; 

Shcw_Cursor(X  +  width  DIV  2,  Y  +  hei^t  DIV  2) ; 

KeyAction  ;=  true; 
end 
else 

KeyAction  :=  false; 

end; 

end; 


*) 


constructor  EditButton.  Init (InitX,  InitY,  InitWidth,  InitHei^t , 

Initcolor,  InitH  i  T  .1  teColor ,  InitNameColor , 
InitHiliteNameColor :  word ; 

InitText:  string;  InitCursorPosition, 

InitTextOffSet;  integer; 

InitStringLength  :  integer; 

InitQearString  :  boolean) ; 

{ 

★★A********************************************************************* 
*  * 

*  ropposE  * 

*  Object  initialization  for  a  text  button  that  the  user  can  * 

*  type  into.  Essentially  a  little  one-line  note  pad.  * 

*****w****************************************************************** 

} 

begin 

ClearString  :=  InitClearString; 
editstringlength  ;=  InitStringLengch; 

FixedControl .  Init  ( InitX ,  InitY ,  InitWidth ,  InitHei^t , 

Initcolor,  InitHiLiteColor,  InitNameColor,  InitHiliteNameColor)  ; 
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TarttStrdng" 

CursorPosition  :=  InitCCasorPosition; 

Di^layjString  ;=  cx:py(Text_String,l,editstringlength) ; 
textoffset  :=  Initl'extOffSet; 
end; 


procedure  EditEotton.Shcw; 

( 

*************************iilf****it*****'Sit***********************************  ■ 
*  * 
*■  FURPQSIr 

*■  htethod  to,-shCT*/-an  edit:butt6nv  * 

************************************************************************ 

} 

Var 

XX, yy,xl,yl:  integer; 
begin 

Get_CursorXY(xx,yy) ; 
hide_cursor; 

setfillstyle(solidf ill, color) ; 
bar(X,  Y,  X+Width,  Y+Hei^it) ; 
setcolor(Controlcolor) ; 
settextjustify(lefttext,centertext) ; 

outtextxy(X+textoffset,Y  +  Hei^t  DIV  2  +  l,Display_String) ; 
rectangle(X,Y,X+Width,Y+fIeight) ; 
shcw_cursor(xx,yy) ; 
end; 


procedure  EditButbon.ReShow; 

{ 

************************************************************************** 
*  * 

*  rURPCSE  * 

*  Method  to  reshow  an  edit  button  after  the  user  has  changed  * 

*  it.  * 

Ik*********************************************************************** 

} 

Var 

xx,yy,xl,yl:  integer; 
begin 

Get_CursorXY  ( xx ,  yy ) ; 
hide_cursor; 
if  hilited  then 
begin 

setf illstyle  ( solidf ill ,  Hilitscolor) ; 


F-68 


File  Name:  CXKERDI5.PAS 


setcolor(Hiliteeontrolcolor) ; 
end 
else 
begin 

setfillstyle(solidfill,cx3lor)  ; 
setcolor(ContrDlcolor) ; 
end; 

bar(X,  Y,  X+Width,  Y+Height)  ; 
settextjustify(lefttext,centertext) ; 

c3ut±extxy’(X+textoffset>Y  +  Hei^t  DIV  2  +  l,Di^lay_String)  ; 
rectangle(X,Y,X+Width,  Y+Height) ; 
shc:w_cursor(xx,yy) ; 
end; 


*) 


procedure  EditButton .  Hilite  (}^X)S ,  Ypos : word)  ; 

{ 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Method  to  hic^ili^t  an  edit  button.  * 

************************************************************************ 

) 

var 

xl,yl:  integer; 
begin 

IF  O^pos  >=  X)  AND 

<  X+Width)  AND 
(Ypos  >=  Y)  AND 

(Ypos  <  Y+Hei(^t)  TEEN 
BEGIN 

if  not(Hilited)  then 
begin 

hide__cursor; 

Hilited  :=  TRUE; 

setfillstyle(solidfill,hilitecolor)  ; 
bar(X;Y,X-Width,  Y+Height)  ; 
setcolor(hilite(:tontrolcolor) ; 
settextjustify(lefttext,centertext)  ; 

outtexbQr(X+textoffset,Y  +  Hei<^t  DIV  2  +  l,Display_String)  ; 
rectangle  (X,Y, X+Width,  Y+Heii^t) ; 
shcw_cursor  (]^x)s ,  Ypcs) ; 
end; 

END 

ELSE 

IF  HiLited  IHEN 
begin 

hilited  :=  FALSE; 
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SY&mt 

end; 


end; 


procedure  EditBiitton.DisplayText(NewText:editstring) ; 


{ 

************************************************************************ 


*  * 
*.  HIRP0SE.  * 

*•'  Metho#  to'^write -nw^text  to  an-aiready-,  displayed  edit  * 

*  button.  * 


************************************************************************ 

) 

var 

xl  :  integer; 
begin 

IF  Hilited-  IHEN 

setcolor  (HiliteColor) 
else 

setcolor  (color) ; 

settextjx:stify(lefttext,centertext) ; 

line  (X+text:offset,Y+texthei^t(Display_String[l])+ (Height  div  2) -2, 

X+Width“textoffset,Y+texthei'^t(Display_String[l])+(Hei^t  div  2)~2); 
outtextxy(X+textoffset,Y  +  Hei<^t  DIV  2  +  l,Display_String) ; 

Display_String  ;=  NewText; 

IF  Hilited  THEN 

setcolor  (HiliteControlColor) 
else 

setcolor  (Controlcolor) ; 
settextjustify(lefttext,centertext) ; 

outtext>y(X+textoffset,Y  +  Hei^t  DIV  2  +  l,Display_String) ; 

xl  :=  X  +  textoffset  +  (CursorFosition  *  textwidth(Display_Stringri]) )  ; 
line  (xl-textwidth(Display_String(13) , 

Y+texthei^t(Display_String[13) -2+ (Height  div  2), 
xl, 

Y+texthei(^t  ( Display_Strir}g  [  1 3 )  -2+  (Height  div  2 ) ) ; 

end; 


*) 


funccion  EditButton.Action(}$xos,Ypcs  :  word);  boolean; 

{ 

************************************************************************ 
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*  * 

*  PURPOSE  * 

*  Method  to  handle  the  viser  text  input  to  the  edit  button  * 
******************** **************************************************** 

} 

cxjnst 

DEL  =  210 7 

HOME  =  198; 

END_  =  206; 

CTRL  END  =  244; 


tnp  ;  string[l]; 

DStr  ;  editstring; 

tenpstring  ;  string; 

)«ey, 

button, 

maxchars, 

tenpLength, 

Str_Start, 

Str__Stcp  ;  Integer; 
begin 

Action  ;=  FALSE; 

if  FixedControl. Action (J^x>s,Ypos)  then  begin 
Hide_Cursor; 

Action  :=  true; 
if  ClearString  then 
tenpstring  ;=  " 
else 

tenpstring  ;=  Text_String; 
maxchars  :=  editstringlength; 
teirplength  :=  length  (tenpstring) ; 
if  (teirplength  <  editstringlength)  then  begin 
Str_Start  :=  1; 

CursorPosition  ;=  tenplength  +  1; 
end 

else  begin 

Str_Start  ;=  tenplength  -  editstringlength  +  2; 
CursorPosition  ;=  editstringlength; 
end; 

Str_Stcp  :=  tenplength; 
r^)eat 

DStr  :=  ccpy(tenpstring,Str_Start,Str_Stcp)  ; 
DisplayText(DStr) ; 

key  ;=  0; 


F-71 


File  Name:  CX)NrRDLS.PAS 


butigbn  ':='0; 

viiile  (key  =  0)  do  begin 
get_key(key)  ; 
button  :=  get_buttons; 
if  (button  *=  left_button_press€d)  then 
k^  :=  enter; 

if  (button  =  ri^t_button__pressed)  then 
key  :=  esc; 

end; 


case  key  of 

BAeKSPAGE:  :  begin 

if  (CursorPosition  >  1)  then  begin 
delete (terapstring,  Str_Start+CursorPosition-2 ,  1); 
dec (CursorPosition) ; 
dec(teiTplength) ; 
end 

else  begin 

if  (Str_Start  >  l)  then  begin 
dec(Str_Start) ; 

delete  (tenpstring,  Str_Start+CursorPosition-l,  1) ; 
dec(tenplength) ; 
end 
else 
beep; 

end; 

end; 

DEL  :  begin 

if  (StrjStart  +  CursorPosition  -  l  <=  tenplength)  then  begin 
delete  (tenpstring,  Str_Start+CursorPosition-l,  1) ; 
dec(tenplength) ; 
end 

else  beep; 
end; 

KCME  :  begin 

StrjStart  ;=  1; 

CursorPosition  ;=  1; 
end; 

END_  :  begin 

if  (tenclength  <  maxchars)  then  begin 
StLjStart  :=  1; 

CursorPosition  :=  templength  -f  i; 
end 

else  begin 
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Str_Start  :=  tenplength  -  maxchars  +  2; 
CursorPosition  :=  maxdiars; 
end; 
end; 


CIKL_END  :  begin 

if  (Str_Start  +  CursorPosition  “  1  <=  tenplength)  then  begin 
delete  (tenpstring,  StrjStart  +  CursorPosition  -  1,  255) ; 
tenplength  ;=  length  (tenystring) ; 
end; 
end; 

IEFr_ARROW  :  begin 

if  (CursorPosition  >  1)  then 
dec ( CursorPosition) 
else 

if  (StrjStart  >  1)  then 
dec(Str__Start) 
else  be^; 

end; 

RLCHr_ARPCM  :  begin 

if  (CursorPtosition  <  maxchars)  and 

((Str__Start  +  CursorPosition  -  1)  <=  tenplength)  then 
inc  (CursorPosition) 
else 

if  ( (StrjStart  +  CursorPosition  -  1)  <=  tenplength)  then 
inc(Str_Start) 
else  beep; 

end; 

else  begin 

if  ((CursorPosition  =  1)  and  (Str_Start  =  1)  and  (chr(key)  =  '  '  ))  then 
beep  (*  do  not  allcw  leading  blanks  in  string. . .  *) 

else  begin 

if  (chr(key)  >  '  ')  and  (chr(key)  <=  'z')  then  begin 
tnp  ;=  irocase(chr(key) ) ; 

insert (tep,  terrpstring,  Str_Start  +  CursorPosition  -  1) ; 
inc(tenplength) ; 

if  (CursorPosition  <  maxchars)  then 
inc  (CursorPosition) 
else 

inc(Str_Start) ; 
if  teirplength  <  maxchars  then 
Str_Stop  ;=  tenplength 
else 

Str_Stop  ;=  Str_Start  +  maxchars  -  1; 

end; 

end; 
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end; 

end;  (*  of  case  statement  *) 

until  ( (  key  =  ENTER  )  or  (  key  =  ESC  ) ) ; 

if  (key  =  ENTER)  then  begin 
Text_String  :=  teirpstring; 

DStr  :=  cc^(Text_String,l,editstringlength) ; 

DisplayText(DStr) ; 
end 

else-'.begin* 

DStr  ;=  cqpy(Text_String,l,editstringlength)  ; 

DisplayText(DStr) ; 
end; 

setcolor  (HiliteGolor)- ; 

line  (X+textoffset,Y+texthei^t{Display_String[l])  +  {Hei^t  div  2)-2, 

X+Width-textof f set ,  Y+texthei^t  (DisplayjString  [  1  ] )  +  {Hei<^t  div  2 )  -2 ) ; 
Shcw_Cursor(}$x3s,Ypos) ; 
end; 
end; 


(*  ><><><0<><><><><><><><C><><><>0<><><><><><><><><><><><><><><><><><><><><><  *) 

procedure  EditButton. Change_String(NewText:  string) ; 

{ 

************************************************************************ 

*  ★ 

*  HJRPOSE  * 

*  Method  to  change  the  edit  button's  text  vholesale  * 

************************************************************************ 

) 

begin 

Text_String  :=  NewText; 

Display_String  :=  cc!py(Text_String,l,EditStringLength) ; 
end; 

(*  ><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><  *) 


constructor  NumberButton .  Init  ( InitX ,  InitY ,  InitWidth ,  InitHeight , 

Initcolor,  InitHiLiteColor,  InitNameColor,  InitHiliteNameColorrword; 
InitValue ; real ; Initlnt , InitFrac ; integer) ; 

{ 

************************************************************************ 


*  * 

*  RJRIOSE  * 

*  Object  initializatio  for  a  buttx^n  that  contains  a  number  * 

*  that  can  be  charioed  by  the  user.  * 


************************************************************************ 

) 

var 

Valuest :  shortstring ; 
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begin 

Int  :=  Initint; 
FTcic  :=  InitFrac; 


Str(InitValue:Int:Frac,Valuest) ; 

Value  ;=  Initvalue; 

Te:^tButton.  Init  (InitX,  InitY,  InitWidth,  InitHei^t, 

Initcolor ,  InitHiLiteColor ,  InitNameColor ,  InitHiliteNameColor , 
Valuest,dir(0) ) ; 

end; 


*) 


procedure  NumberButton.Shcw; 

{ 

************************************************************************ 
*  * 

*  HJRPOSE  * 

*  Method  to  display  a  nurnber  button.  * 

************************************************************************ 


} 

var 

XX,  yy;  integer; 
begin 

str (value;  int:  frac, name) ; 
TextButton. Shew; 
end; 


(*  ><><><><><><><><><><C><><><><><>C><><><><><><><><><><><><><><><>0<><><  *) 

function  NumberButton .  Action  (}^X5S ,  Ypos ;  word) :  boolean ; 

{ 

*  * 

*  PURPOSE  * 

*  Method  to  handle  user  editin9  lUmber  button.  * 

*****************************************  .*********************x*** 

) 

var 

tenpvalue ,  newvalue ;  shortstring; 
button,  nura;  integer ; 
key;  char; 
begin 

IF  TextEutton.Action(>toDS,Ypcs)  IKEN 
begin 

Action  :=  TRUE; 
hide_cursor; 
tencvalue  ;=  Name; 

QiangeName(") ; 
newvalue  ;= 
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begin 

IF  keypressed  THEN 
begin 

key  :=  readkey; 

CftSE  key  OF 
'O'. .'9"; 
begin 

IF  (textwidth(newvalue+key)  <  Width)  IHEN 
newvalue,  :=‘newvalue.+  key; 

end; 

/  t  • 

•  • 

begin 

IF. POS newvalue)-  =  0  .THEN,, 
newvalue'-  :*=  newvalue’-+  key; 

end; 

'_' . 

begin 

IF  (textwidth(newvalue+-key)  <  Width)  THEN 
IF  Length (newvalue)  =  0  THEN 
newvalue  :=  newvalue  +  key; 

end; 

chr(DEL) : 
begin 

IF  (length(newvalue)  >  0)  THEN 

newvalue[03  ;=  chr (length (newvalue)  -  1) ; 

end; 

end;  (case) 

ChangeName (newvalue) ; 
end; 

button  ;=  get_buttons; 
end; 

until(key  =  chr(CR))  OR  (key  =  chr(ESC)) 

OR  (button  =  ri^t_button__pressed)  OR  (button  =  left_button_pressed)  ; 

IF  ((key  =  chr(CR))  OR  (button  =  left_button_pressed) )  AND  (length (newvcilue)  >  0)  THEN 
begin 

val( newvalue, value,  num) ; 
str (value; int:frac, newvalue) ; 

val  (newvalue, value, num) ;  {  do  it  again  to  truncate  the  unwanted  characters  ) 

{  e.g. ,  if  the  value  is  0.25  and  you  specified  a  formartin 
{  of  5:0,  you  want  to  get  0  for  the  value,  not  0.25  ) 

{  QiangeText  (newvalue) ; ) 

end 
else 
begin 

val (tenpvalue, value, num) ; 
str(value:int:frac,tsnpvalue) ; 

val  (tenpvalue, value,  num) ;{  do  it  again  to  truncate  the  unwanted  characrars  j 

{  e.g.,  if  the  value  is  0.25  ard  you  specified  a  formarrin 
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{  of  5:0,  you  want  to  get  0  for  the  value,  not  0.25 

{  ChangeO?ext(tenpvalue) ; ) 

end; 

shcw_cursor(XPos,ypos) ; 
end 
ELSE 

Action  :=  FALSE; 

end; 


constructor  StatusButton.Init(InitX,InitY,InitWidth,InitHeight, 

Initcolor ,  InitHiLiteColor,  InitSelectedColor, 

InitNameColor ,  InitHiliteNameColor ,  InitSelectedNameColor:  word; 
InitName:  shortstring) ; 

{ 

************************************************************************ 
*  * 

*  KJRPOSE  * 

*  Object  initialization  for  a  )dLnd  of  text  button  that  has  * 

*  a  remembered  on/off  state.  Usefull  for  selection  controls.  * 
************************************************************************ 

} 

begin 

TextButton.  Init  (InitX,  InitY,  InitWidth,  InitHeight , 

Initcolor,  InitHiLiteColor, 

InitNameColor,  InitHiliteNameColor,  InitName, '  ' ) ; 

SelecbedColor  :=  InitSelectedColor; 

SelectedNameColor  :=  InitSelectecSIameColor; 

Selected  :==  FALSE; 
end; 


procedure  StatusButton.Shcw; 

{ 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Method  for  shewing  a  status  button.  * 

************************************************************************ 


) 

var 

XX, yy: integer; 
begin 

get_cursorXY  (xx,  yy) ; 
Hide_cursor; 

IF  Selected  THEN 
begin 
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setf iills^le  (-sol-idf ^1-,  S^-eetMeploi?)!’; 
setcolor(SelectedNairecolor) ; 
end 
EISE 
begin 

setfillstyle(solidfill,cx}lor)  ; 
setaDlor(C&ntrolcolor) ; 
end; 

ban  (X ,  Y ,  X4Width ,  Y+Hei^t).  ; 
settejd:justify(cenbei:1:ext,cente^^  ; 
out±ext3Cf(X+Width  DIV  2,Y  +  Hei^t  DIV  2  +  l,naine),; 
rectangle  (X,Y,X-Width,Y+Hei^t) ; 
shcwj^cur?or(xx7,yy;) ; 
end; 


*) 


procedure  StatusButton.HiLite(J^xDS,Ypos:word) ; 

{ 

************************************************************************ 

*  * 

*  R3KP0SE  * 

*  Method  for  hi<^i^ting  a  status  button.  * 

************************************************************************ 

} 

begin 

IF  (5$30S  >=  X)  and  (^ipos  <  X+Width)  AND  (Ypos  >=  Y)  AND  (Ypos  <  Y+Height)  THEN 
BEGIN 

{ 

IF  NameChanged  THEN 
BEGIN 

Hide_Cursor; 

ChangeNaine(naine) ; 

Show_Cursor(}toos,Ypos) ; 

NameQxanged  :=  FALSE; 

END; 

} 

IF  NOT  Hilited  THEN 
begin 

hide_cursor; 

Hilited  :=  TRDE; 

setfillstyle(solidfill,hilitecolor) ; 
bar(X,Y,X+Width,Y+Height) ; 
setcolor(hiliteControlcolor) ; 
settextjustify(centercext,c8ntertext) ; 
outtextxy(XtWidth  DIV  2,Y  +  Height  DI\^  2  -i-  l,naine)  ; 
rectangle (X,Y,X-Width,Y+Hei<^t) ; 
show_cursor(XpGS,Ypcs) ; 
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end-; 

END 

ELSE 

IF  HiLited  THEN 
begin 

hilited  ;=  FALSE; 
Shew; 
end; 

end; 


procedure  StatusBut±on.TumOn; 

{ 

**************************************************************************** 
*  * 

*  RJRPOSE  * 

*  Method  for  turning  the  status  button  state  on.  * 

*****'****************************★******************'**★***************** 

} 

var 

XX, yy;  integer; 
begin 

selected  ;=  TRUE; 

Shew; 

end; 


procedure  StatusButton.TumOff ; 

{ 

***************************************************************************** 
*  * 

*  PURPOSE  * 

*  Method  for  turning  the  status  button  state  off.  * 

*•****•*•**•*•********■*•*•*•**•****•****■***■***•********•***■***•********•***■*********•** 

) 

var 

XX,  yy;  integer; 
begin 

selected  :=  FALSE; 

Shew; 

end; 


constructor  TextEuttonSD. Init (InitX, InitY, Initwidth,  InitHei^t, 

Initcolor ,  InitHiLiteColor ,  InitNaroeColor ,  InitHilitaNaroeColor :  word ; 
InitNaine :  shortstring ;  InitHotKey ;  char) ; 
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{ 

**********************************************************'**»****.*‘****^*«' 
*  * 

*  lURPOSE  * 

*  Method  for  three  dimensional  looking  tejct  button.  * 

************************************************************************ 

) 

var 

x2>  y2,  i:  Integer; 
begin 

TextButton.  Init  (InitX^  InitY,  InitWidth,  InitHeight, 

Initcolor ,  InitHiLiteColor,  InitNameCplor , 
InitHiliteNameeolor,InitName>InitHotK^)  ; 

end  ; . 

(*  ><><><><><><><><><><><>o<><><><><><><><><><><><><><><><><><><><><><><^  *) 

procedure  TextButtonSD.Shcw; 

{ 

************************************************************************ 

*  * 

*  HJRPOSE  * 

*  Method  for  three  dimensional  looking  text  button.  * 

************************************************************************ 

) 

Var 

i ,  x2 , y2 , XX , yy : integer ; 
begin 

Get_CursorXY(xx,yy) ; 
hide_cursor; 
x2  :=  X+Width; 
y2  :=  Y+Hei^t; 

TextButton .  Shew ; 
setcolor (color) ; 

rectangle (X,Y,X+Width,Y+Hei(^t)  ; 

Setcolor  (li^tgray) ; 

FOR  i  :=  0  to  2  EO  BEGIN 

Line(X+i+i,  Y+i,  x2-i,  Y+i) ; 

Line(X+i,Y4-i+i,  x-ri,  y2-i) ; 

END; 

SetColor(darkgray) ; 

R)R  i  :=  0  to  2  DO  BEGIN 

Line(x2-l-i,  y2-i,  X+l+i,y2-i) ; 

Line(x2-i,  y2-l-i,  x2-i,  Y+i+i) ; 

END; 

shcw_cursor{xx,yy) ; 
end; 
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procedure  TextButton3D.Hilite(}$x3s,Ypos:vrord)  ; 

{ 

************************************************************************** 

*  * 

*  rURPOSE  * 

*  Method  for  three  dimensional  looking  text  button.  * 

************************************* ********************** ************* 

) 

var 

i,x2,y2:  integer; 
begin 

IF  >=  X)  AND  i^ipos  <  X+Width)  AND  (Ypos  >=  Y)  AND  (Ypos  <  Y+Height)  THEN 

BEGIN 

if  not  Hilited  then  begin 
TextButton.HiLite(3$X5S,Ypcs) ; 
hide_c'rsor; 
setcolor(hilitecolor) ; 
rectangle(X,Y,X+Width,Y+Hei^t) ; 

SetColor(darkgray)  ; 
x2  :=  X+Width;  . 
y2  :=  Y+Hei<^t; 

FOR  i  ;=  0  to  2  DO  BEGIN 

Line(X+l+i,  Y+i,  x2“i,  Y+i) ; 

Line(X+i,Y+l+i,  X+i,  y2“i) ; 

END; 

SetColor(li^tgray)  ; 

FOR  i  :=  0  to  2  DO  BEGIN 
Ldne(x2-l-i,  y2-i,  X+l+i,y2-i) ; 

Iiine(x2-i,  y2-l-i,  x2-i,  Y+l+i) ; 

END; 

shc:w_cursor(}^xjs,Ypos) ; 
end; 

END 

EISE 

IF  HiLited  IKEN 
begin 

hilited  ;=  FALSE; 

Show; 

end; 

end; 


constructor  EditButtonO  D .  Init  ( InitX ,  InitY ,  InitWidth ,  InitKei^t , 

Initcolor,  InitHiLiteColor,  InitNameColor , 
InitKiliteNaroeColor ;  word ; 

InitText :  string ;  InitOursorPosition , 
InitStringLsngth:  integer; 
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InitOL^irStsping-jboole^),;; 

{ 

*  * 

*  RJRPOSE  * 

*  Method  for  three  dimensional  looking  edit  button.  * 

************************************************************************ 

) 

begin 

EditBitton .  Init  ( InitX ,  InitY ,  InitWidth ,  InitHei(^t , 

Initcolor ,  InitHiLiteOolor ,  InitNameColor , 

InitHiliteNameQolor ,  Iiiitrext,  InitCursorPosition,  4 , 
InitStringlengtii,  InitClearString), ; 

end'?'* 

procedure  EditButton3D.Shcw; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Ifethod  for  three  dinvensional  looking  edit  button.  '  * 

************************************************************************ 

} 

Var 

i ,  x2 ,  y2 ,  XX ,  yy :  integer ; 
begin 

Get_CursorXY(xx,yy) ; 
hide_cursor; 
x2  :=  X+Width; 
y2  :■=  y+Hei^t; 

EditButton .  Shew  ; 
setcolor( color) ; 

rectangle (X,Y,X-H«?idth,Y+Hei(^t) ; 

SetColor(lightgray) ; 

FOR  i  :=  0  to  2  DO  BEGIN 

Line(X+l+i,  Y+i,  x2-i,  Y+i) ; 

Line(X+i,Y-il+i,  X+i,  y2-i) ; 

END; 

SetColor(darkgray) ; 

FOR  i  :=  0  to  2  DO  BEGIN 

Line(x2-l-i,  y2-i,  X+l+i,y2-i) ; 

Line(x2-i,  y2-l-i,  x2-i,  Y+l+i) ; 

END; 

show_cursor(xx,yy) ; 
end; 


*) 
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procedure  BditButton3D.Hilite(Xfxss,Ypc5s:word) ; 

{ 

★  * 

*  HMOSE  * 

*  Method  for  three  dimensional  looking  edit  button.  * 

************************************************************************** 

) 

var 

i,x2,y2:  integer; 
begin 

IF  (5^  >=  X)  AND 
(Xpos  <  X-Width)  AND 
(Ypos  >=  Y)  AND 
(Ypcs  <  Y+Height)  THEN 
BEGIN 

if  not(Hilited)  then  begin 
BditButbon.  HiLite  (X^xs ,  Ypos) ; 
hide_cursor; 
setcolor(hilitecolor) ; 
rectangle(X,Y,X4Width,Y+Hei^t) ; 

SetColor(dar)ogray) ; 
x2  :=  X+Width; 
y2  ;=  Y+Hei^t; 

FOR  i  :=  0  to  2  DO  BEGIN 

Line(X+l+i,  Y+i,  x2-i,  Y+i) ; 

Line(X+i,Y+i+i,  x+i,  y2-i) ; 

END; 

SetColor(lichtgray) ; 

FOR  i  :=  0  to  2  DO  BEGIN 

Line(x2-l~i,  y2-i,  X+l+i,y2-i) ; 

Line(x2-i,  y2-l-i,  x2-i,  Y+l+i); 

END; 

shcw_cursor(}$)os,Ypos) ; 
end; 

END 

ELSE 

IF  HiLited  IHEN 
begin 

hilited  :=  FALSE; 

Show; 

end; 

and; 


procedure  TextEutton3D.ChangeName(NewNaine:shorcstring) ; 

{ 
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**************************************!jt*'.***********'i*ifc********yW6iHt'****'**v. 
*  * 

*  PURPOSE  * 

*  Methcxi  for  three  dimensional  looking  text  button.  * 

************************************************************************* 

) 

var 

x2, y2,i: integer; 
begin 

Name*r:=  -NewName;* 

ShcW'7 

end; 


(*-><>si><><><><><><><><><>CsC><><^<><>jC>0<><><><><><><><><><><><><><><><><><  *) 

constructor  UPArrc^fiutton.  Init (InitX, InitY,  InitWidth,  InitHeight:  integer; 

Initcolor,  InitHiLiteColor ,  InitControlColor,  InitHiliteControlColorrword) ; 

{ 

************************************************************************ 

*  * 

*  HJRPOSE  * 

*  Ctoject  initialization  for  an  vp  arrow  control  display.  * 
************************************************************************- 

) 

begin 

FixedCorrtrol .  Init  (InitX,  InitY,  InitWidth,  InitHeight, 

Initcolor,  InitHiLiteColor,  InitControlColor ,  InitHiliteControlColor) ; 

end; 


(*  ><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><  *) 

procedure  UpArrowButton.Show; 

{ 

*  ★ 

*  PURPOSE  * 

*  Method  for  displaying  an  up  arrow  control.  * 

***********************************************************************x 

) 

var 

XX,  yy:  integer; 
begin 

get_cursorXY(x>i,yy)  ; 

Hidejcursor; 

setfillstyle(solidf ill, color) ; 
bar(X,Y,X-fWidth,Y+Height)  ; 
setcolor(ControlColor) ; 
line(X-fWidth  DIV  2,Y-f2,X-i-2,Y+Keight-2)  ; 
line(X+Width  Dr\7  2,Y4-2,X+Width-2,Y+Hei^t-2)  ; 
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line  (X+2 ,  Y4Hei^t-2 ,  X4Width-2 ,  y+Hei^t-2 )  ; 
setfillstyle(solidfill,Contxolcolor) ; 
flcxxifill(X+Width  DIV  2,Y+Height  DIV  2,Contxolcolor)  ; 
rectangle (X,Y,X-+Width,Y+Hei^t) ; 
shcw_cursor(xx:,yy) ; 
end; 


procedure  UpArn:si;Button.HiLite(}$xos,Ypcs:Word) ; 

{ 

***********************‘***************************************'*********** 

★  * 

*  RJRPOSE  * 

*  Method  for  hi^i^ting'.-an  tp  arrow  control.  * 

************************************************************************ 

) 

begin 

IF  (}{pos  >=  X)  AND  (Xpos  <  X+Width)  AND  (Ypos  >=  Y)  AND  (Ypos  <  Y+Hei<^t)  THEN 
begin 

IF  NOT  Hilited  IHEN 
begin 

hide__cursor; 

Hilited  ;=  TRUE; 

setfillstyle(solidfill,hilitecolor) ; 
bar(X,Y,X-Width,Y+Hei^t)  ; 
setcolor(HiliteControlColor) ; 
line(X+Width  DIV  2,Y+2,X+2,Y+Height-2) ; 
line(X+Width  DIV  2,Y+2,X4Width-2,Y+Height-2) ; 
line  (X+2 ,  Y+Hei^t-2 ,  X+Width-2 ,  Y+Height-2 )  ; 
setfillstyle(solidfill,HiliteControlColcr) ; 
floodf ill (X+width  DIV  2,Y+Height  DIV  2,HiliteControlcolor); 
rectangle (X,Y,X+Width,Y+Height) ; 
shcw_cursor(Xpos,Ypos) ; 
end 
end 
ELSE 

IF  Hilited  THEN 
begin 

HiLited  FALSE; 

Show; 

end; 

end; 


constructor  DcwnArrowButton. Init (InitX, InitY, InitWidth, InitHeight: integer; 

Initcolor,  InitHiLiteColor,  InitControlColor ,  InitHiliteControlColor ;word) ; 


{ 
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*********  *************************************^**********'********S:****.*?fc'. 
*  * 

*  PURPOSE  * 

*  Ctoject  initialization  for  a  down  arrow  control  display.  * 
************************************************************************ 

} 

begin 

FixedControl .  Init  (InitX,  InitY,  InitWidth,  InitHeight , 

Initcolor ,  InitHiLiteColor ,  InitControlColor ,  InitHiliteContnolColor) ; 

end; 


procedure  DownArrowButton.Shcw; 

{ 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Method  for  down  arrow  control  display.  * 

************************************************************************ 


XX,  yy;  integer; 
begin 

get_cursorXY (xx,yy) ; 

Hide_cursor; 

setf illstyle ( solidf ill , color) ; 

bar  (X,  Y , X+Width,  Y+Height)  ; 

setcolor(ControlColor) ; 

line(X+Width  DIV  2,Y+Height-2,X+2,Y+2) ; 

line(X+Width  DIV  2,Y+Height-2,X+Width-2,Y+2)  ; 

line (X+2 , Y+2 , X+Width~2 , Y+2 ) ; 

setfillstyle(solidfill,Controlcolor) ; 

floodf ill (X+Width  DIV  2, Y+Height  DIV  2 , Controlcolor ) ; 

rectangle(X,Y,X-Width, Y+Height) ; 

show_cursor(xx,yy) ; 


procedure  DcwnArrowEutton.HiLite(}toas,Ypcs;Word) ; 

{ 

*  it 

*  PURPOSE  * 

*  Method  for  down  arrow  control  higili^ting.  * 

***********************************************K***5r**************x***** 


begin 
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IF  (3$>os  >=  X)  AND  Ciipos  <  X+Width)  AITO  (Ypos  >=  Y)  AND  (Ypos.  <  Y+Height)  THEN 
begin 

IF  NOT  Hilited  IHEN 
begin 

hide_cursor; 

Hilited  :=  TRUE; 

setfillstyle(solidfill,hilitecolor) ; 
bar(X,Y,X4Width,Y+Hei^t)  ; 
setcolor(HiliteControlColor) ; 
line(X+Width  DIV  2,Y+Height-2,X+2,Y+2)  ; 
line(X-Width  DIV  2,Y+Height-2,X-fWidth-2,Y+2)  ; 
line  (X+2 ,  Y+2 ,  X4Width~2 ,  Y+2 )  ; 
setfillstyle(solidfill,HiliteControlColor) ; 
floodfill(X+Width  DIV  2, Y+Height  DIV  2,HiliteeonUolcolor); 
rectangle (X,Y,X+Width,Y+Hei^t) ; 
shcw_cursor(}^30s,Ypos) ; 
erd 
end 
ELSE 

IF  Hilited  THEN 
begin 

Hilited  ;=  FALSE; 

Shew; 

end; 

end; 


(*  ><><>o<><><><><CK><><><><><><>c<>o<><><><cxe><><><>o<><><><><><>^^  *) 

constructor  LeftArrowButton .  Init  ( InitX ,  InitY ,  Ini  twidth ,  InitHeight :  integer ; 

Initcolor ,  InitHiLiteColor,  InitContrcl'tolor,  InitHiliteControlColor;  word) ; 

{ 

************************************************************************ 

*  * 

*  PURPOSE  * 

*  Initialization  for  left  arrow  control.  * 

************************************************************************ 

} 

begin 

FixedControl .  Init  ( InitX ,  InitY ,  InitS-Jidth ,  InitHeight , 

Initcolor ,  InitHiLiteColor ,  InitControlColor ,  InitHil  iteControlColor) ; 

end; 


*) 


procedure  LeftArrowButton. Shew; 

{ 

******************************>**************■>!:************************** 
*  * 
*  PURPOSE  * 
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display.^  * 

************************************************************************ 

) 

var 

»c,yy:  integer; 
begin 

getjrursorXY (xx,yy) ; 

Hide_cursor; 

setfillstyle(solidfill, color)  ; 
bar^X,Y>X-Width,Y+Hei0t) ; 
setcolor(ControlColor) ; 
line (X+2 ,  YH^Jeight-  DIV  2 , X+Width-2 , Y+2)  ; 
lina(X+2,Y+Hei^t  DIV'  2,X-Width-2,Y+Heigi:it-2)  ; 
line  (X+WicJthr2 ,  Y+2 ,  X4Width-^2 ,  Y+Heightr2 )'  ; 
setf illstyle ( solidf ill , Controlcolor) ; 
floodfill(X+Width  DIV  2,Y+Height  DIV  2,Controlcolor); 
rectangle(X,Y,X-Width,y+Height) ; 
shcw_cursor(xx,yy) ; 
end; 


procedure  LfiftArTcwButton.HiLite(}$)os,Yix3s:Word) ; 

{ 

1t1tii*ii***itie**if**ii1i***ii***-k***ifk***icit*-k*-kic******************************** 

*  * 

*  HJRPOSE  * 

*  Method  for  left  arrcw  control  hii^ighting.  * 

************************************************************************ 

} 

begin 

IF  (Xpos  >=  X)  ?.ND  <  X+Width)  AND  (Ypos  >=  Y)  AND  (Ypcs  <  Y+Height)  THEN 

begin 

IF  NOT  Hilited  THEN 
begin 

hide_cu7.sor; 

Hilited  :=  TRUE; 

setf  illstyle  (solidf  ill,  hilitecolor) ; 
bar(X,Y,X+Width,  Y+Height) ; 
setcolor(HiliteControlColor) ; 
line  (X+2,  Y+Hei^t  DIV  2,X+Width~2,Y+2)  ; 
line  (X+2,  Y+Hei^t  DIV  2,X+Width-2,Y-HIeight-2)  ; 
line  (X+Width-2 ,  Y+2 ,  X+Width-2 ,  Y+Height-2 )  ; 
setf  illstyle  (solidf  ill,  HiliteControlColor) ; 
flocdfill (X+Width  DIV  2,Y+Kei^t  DIV  2,HiliteControlcolor) ; 
rectar^le(X,Y,X+Width,  Y+Height) ; 
show_cursor(»X)S,Ypcs) ; 
end 
end 
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ELSE 

IF  Hilited  IHEN 
t)egin 

HiLited  :=  EAISE; 
Shew; 
end; 

end; 


constructor  Ri^tArrewButbon  i  Init  ( InitX,  InitY ,  InitWidth ,  InitHei(^t :  integer  ; 

Indtcolor ,  InitHiLiteOolor ,  InitControlColor ,  InitHiliteCTintrolColor ;  word) 

{ 

★★★★★A****************************************************************** 

*  * 

*  rURPOSE  * 

*  Initialization  for  ri^t  arrew  control.  * 

************************************************************************ 

} 

begin 

FixedControl .  Init  (InitX^  InitY,  InitWidth,  InitHeight, 

Initcolor ,  InitHiLiteColor,  InitCont:  >  .Color,  InitHiliteControlColor) ; 

end; 


procedure  Ri^tArrcwButton.Shcw; 

{ 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Method  for  ri^t  arrow  control  display.  * 

************************************************************************ 

} 

var 

XX, yy: integer; 
begin 

get_cursorXY  (xx,yy) ; 

Hide_cursor; 

setfillstyle(solidf ill, color) ; 
bar  (X,  Y,  X-fWidth,  Y+Height)  ; 
setcolor(ControlColor) ; 
line(X+width“2,Y+Hei^t  DIV  2,X+2,Y+2) ; 
line (X4width-2, Y+Height  DIV  2,X+2,Y+Height-2) ; 
line  (X+2 ,  Y+2 ,  X+2 ,  Y-Hiei^t-2 )  ; 
setf illstyle  ( solidf  ill ,  Osntrolcolor ) ; 
flocdf ill (X+Width  DIV  2,Y+Hei^t  DIV  2 , Controlcolor) ; 
rectangle(X,Y,X+Width,Y+Heii^t)  ; 
show_cursor(xx,yy) ; 
end; 
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prbeedure-'Id^t^jTGttStlfetcaivHi]^^ 

{ 

************************************************************************* 

*  * 

*  HJRPOSE  * 

*  Method  for  ri^t  arrow  control  hi^i^ting.  * 

★★★★★A****************************************************************** 

} 

begin 

IF  (}^  >=  X)  AND  {^ipos  <  X+Width)  AND-  (Ypos'  >=  Y)  AND-*  (YpOS-  <  Y+Height)  IHEN 
begin 

IF  -NOT  Hilited  THEN 
begin; 

hide__cursor; 

Hilited  :=  TRUE; 

setfillstyle(solidfill,hilitecolor) ; 
bar (X,Y,X-Width,  Y+Height)  ; 
setcolor(HiliteControlColor) ; 
line(X+width-2,Y+Hei^t  DIV  2,X+2,Y+2)  ; 
line (X+width-2, Y+Height  DIV  2,X+2,Y+Height~2); 
line(X+2,Y+2,X+2,Y+Hei^t-2) ; 
setfillstyle(solidfill,HiliteControlColor) ; 
floodf ill (X+Width  DIV  2,Y+Hei^t  DIV  2,HiliteControlcolor) ; 
rectangle (X,Y,X+Width,Y+Hei^t)  ; 
shcw_cursor(XJ»s,Ypos) ; 
end 
end 
ELSE 

IF  Hilited  THEN 
begin 

Hilited  :=  FALSE; 

Show; 

end; 

end; 


(*  ><>0<><><><><>0<><>0<><><><><><><><0>0<><><><><><><><><><><><><><><><><  *) 

function  catpjte_delta(VAR  V,Hi,Io:real;Acc:integer; 

Accelf ;  real ;  orientation :  boolean) ;  integer ; 

{ 

*************■********************'*•******  A******************************* 


*  * 

*  HJRPCSE  * 

*  Function  for  caiputing  how  far  a  slide  bar  slider  control  * 

*  has  travelled.  * 


**************************T*********************Tt********7Clit******X******* 

} 
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var 

del:  integer; 
teirpleng^  :  integer; 

begin 

if  orientation  =  horizontal  then 
tenplength  :=  H_SlideLength 
else  (*  vertical  *) 
tenplength  :=  V_SlideLength; 

IF  V  >=  Hi  THEN 
begin 

V  :=  Hi; 

del  :=  tenplength; 
end 
else 

IF  V  <=  Lo  IHEN 
begin 

V  :=  lo; 

del  ;=  0; 
end 
ELSE 

CASE  Acc  OF 
logscale: 

del  :=  round(In(v  -  Io)/AccelF); 
reverselogscale : 

del  :*  round (tenplength  ~  In(Hi  •7)/AccelF) ; 
linearscale: 

del  :=  round  ( (V-Io)/AccelF) ; 

END;  {  CASE  ) 

IF  del  >=  tenplength-2  THEN 
del  :=  tenplergth-2 ; 
ccanputejdelta  :=  del; 
end; 


constructor  HorizontalSlideBar , Init (InitX, InitY,  InitColor,  InitHiliteColor , 
InitControlColor,  InitHiliteCtontrolColor;wDrd; 

InitLoLim,  IrdtHiLim,  InitlXK:;  real ; 

InitAccel :  integer ;  InitNaitfi ,  Initunits :  shortstring ;  Initint ,  InitFrac :  integer ) ; 

{ 

Tfc  * 

*  PURPOSE  * 

*  Initialization  for  a  horizontal  slide  bar  control.  * 

***ir*********i***********'******************'*'*****')itx?e******iit***'***'5c*'*'**?c** 

) 

var 
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iMfv^uer;  real-; 
delta:  integer; 
begin 

Name  :=  InitNaaue; 

Xfiiits  ;=  Initunits; 

Hilim  :=  InitHilim; 

IcLim  :=  Initloliim; 

Increnient  :=  Initinc; 

Accel  ;=  InitAccel; 

CASE.  Accel  OF 
logscale: 

AccelFactor  :=  IJi(HiLiin-IoLim)  /H_SlideIength; 
reveirselogscale; 

AccelFactor  :='  Ln(Hiiiim-]lo]ibn)-/H_SlideL^^ 
linearscale; 

AccelFactor  :=  (HiLim  -  IrLim)/H_SlideLength; 
else 
begin 

Accel  :=  linearscale; 

AccelFactor  :=  (HiLim  “  IoLim)/H_SlideLength; 
end; 

END;  {  CASE  ) 

initvalue  :=  loLim  +  (HiLim  -  IoLijm)/2; 

FixedControl .  Init  (InitX,  InitY,HjDarwidth,HJoarheii^t, 

Initcolor,  InitHiLiteColor ,  InitControlColor,  IliitHiliteControlColor) ; 

Ri^t .  Init  (X4Width*-arrowwldth ,  Y ,  arrowwidth,  H_barheight , 

color  ,HiLiteColor,  ControlColor  ,HiliteCoi'itrolColor) ; 

Left .  Init  (X,  Y,  arrowwidth,  H_barhei^t , 

color, HiLiteColor ,  ControlColor,HiliteControlColor) ; 

SlideBar .  Init  (X-f-arrowwidthfl ,  Y+1 ,  slidewidth,  Height-2 , 

{Hilitecolor,HiliteControlColor,Q^lor,ControlColor) ; ) 

ControlColor ,  HiLiteColor ,  Color ,  HiLiteControlColor ) ; 

Value .  Init  (X+H_barwidth+5 ,  Y ,  valueWidth ,  H_barhei^t , 

color,  HiLiteColor,  ControlColor,  HilitaControlColor,  initvalue,  InitInt,  InitFrac) 

end; 


procedure  HorizontalSlideBar .  Hilite  (J^xos ,  Ypos :  word) ; 

{ 

***X*'******'***********************'*******************'********'*********** 
*  * 

*  PURPOSE  * 

*  Method  for  a  horizontal  slide  bar  control  hi^ilighting.  * 

***************************'*******'******************'****5i:****'**x**'*'****x 

} 

begin 

Left.Hilite(Xpcs,Ypcs) ; 

Ri^t. Hilite (Xx^, Ypos) ; 
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SlideBar.Hilite(}$xDs,Ypos) ; 
Value. Hilite()$)OS,Ypos)  ; 


procedure  HorizontalSlideBar.Shcw; 

{ 

************************************************************************ 
*  * 

*  H3RP0SE  * 

*  Method  for  a  horizontal  slide  bar  control  display.  * 

************************************************************************ 


delta: integer; 

XX,  Yi':  integer; 
begin 

get_cursonQ^(xx,yy) ; 
setfillstyle(solidf ill, color) ; 
hide_cui.sor; 

bar(X,Y,X-+Width,Y+Height) ; 
setcolor(ControlColor) ; 
rectangle (X,Y,X+Width,Y+Hei^t) ; 
show_cursor(xx,yy) ; 

RL<^t.Show; 
left.  Shew; 

SlideBar.Shcw; 

Value.  Show; 

delta  :=  ccnpjte_delta (Value. value,HiTim,LoLijn, Accel, Accelfactor, Horizontal) ; 

SlideBar .  MoveTo  (X+arrowwidth+l+delta ,  SlideBar .  Y) ; 

get_cursorxy(xx,yy) ; 

hide_cursor; 

setcolor(controlcolor) ; 

settextjustify(rii^ttext,centertaxt) ; 

outtextXY(X-5,Y+height  DIV  2  +  l,Naine); 

settextjustify(lefttext,centertext) ; 

outtextXY (value. X+valuewidth+5,Y+height  DIV  2  -f-  1, units ) ; 
shcw_cursor(xx,yy) ; 
end; 


function  HorizontalSlideBar.Action(}$xDs,Ypos:wDrd) : boolean; 

{ 

****'*******^*********'********'l#r********************'**tV  ********************* 


KJRPCSE 

Method  for  a  horizontiil  slide  bar  control  action. 
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icicicicicificicififieicicififit’kif'kiciticieicificititieieicicicicificic'kicic’k'kieii'k'kieie'k'k'kic'k'k'k'k'k'k'k'k'kic'k'kic'kicieieicieic 

} 

var 

s: shortstring; 

oldx,xinc,newx,newy:integer; 
delta:  integer; 
begin 

Action  :=  FALSE; 

IF  Left. Action (}$)OS,Ypos)  THEN 
begin 

Value. value  :=  Value. value  -  Increment; 

delta  :=  cc3ipjte_delta(Value.value,HiLiin,LoLim, Accel, Accelfactor, Horizontal) ; 
str(Value.valiie:value.int:value.frac,s) ; 

Hide__CXirsor; 

Value .  ChangeName  ( s ) ; 

SlideBar.MoveTto(X+arrcwwidth+l4delta,SlideBar.Y) ; 

Shcw_CursQr(3$x)s,Ypos) ; 

Action  :=  TRUE; 
end; 

IF  Ri^t. Action (J^XDS,Ypos)  THEN 
begin 

Value. value  :=  Value. value  +  Increment; 

delta  :=  ccnpjtejdelta (Value. value, HiLim,LoLim, Accel, Accelfactor, Horizontal) ; 
str( Value. value: value,  int: value. frac,s) ; 

Hide_Cursor; 

Value. ChangeName(s) ; 

SlideBar .  MoveTo  (X+arrwwidth+l-rdelta ,  Slidefiar .  Y) ; 

Shcw_Cursor(Xpos,Ypos) ; 

Action  :=  TKJE; 
end; 

if  SlideBar. Action(:&os,Ypos)  THEN 
begin 

oldx  :=  }$x3s; 

WHILE  Left_Button_Cown  DO 
begin 

G€t_CursorXY  ( newx ,  newy ) ; 

IF  (newx  o  oldx)  OR  (newy  o  Ypos)  THEN 
begin 

hide_cursor; 
xinc  :=  newx-oldx; 

IF  SlideBar. X  +  xinc  >  Ri<^t.X  -  SlideBar. Width  -  1  THEN 
begin 

newx  :=  oldx; 
xinc  :=  0; 
end; 

IF  SlideBar.X  +  xinc  <  Lsft.X  +  left.Width  +  1  THEN 
begin 
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newx  :=  oldx; 
xinc  :=  0; 
end; 

IF  xinc  o  0  THEN 
begin 

delta  :=  SlideBar.X+xinc-X-arxcwwidth-l; 
SlideBar.MoveTo(X+arrcwwidth4-l4delta,SlideBar.Y) ; 

IF  (delta  =  0)  THEN 
Value. value  :=  loLim 
ELSE 

Accel  OF 
logscale: 

Value. value  :=  exp(delta*AccelFactor)  +  LoLira; 
reverselogscale ; 

Value. value  :=  HiLim  -  exp(  (H_SlideLength-2-delta)  *AccelFactor) ; 
linearscale: 

Value. value  :=  delta*AccelFactor+L3Lim; 

END;  {  CASE  ) 

if  delta  >=  H_Slidelength-2  THEN 
Value. value  ;=  HiLim; 

IF  (Value. value  >  HiLim)  THEN 
Value.value  i-  HiLim; 

IF  Value.value  <  Loldm  THEN 
Value.value  :=  loLim; 
str(Value.value;value.int:value.frac,s) ; 

Val'ue.ChangeName(s) ; 
end; 

3hcw_Cursor(newx,Ypos) ; 
end; 

oldx  :=  newx; 
end; 

Action  :=  THJE; 
end; 

IF  Value. Action(}$>os,Ypos)  THEN 
begin 

delta  :=  cai:pute_delta (Value. value, HiLim, LoLim, Accel, Accelf actor, Horizontal) ; 
str (Value. value: value. int; value.  frac,s)  ; 

Hide_Cursor; 

Value.  QiangeName(s) ; 

SlideBar.MoveTo(X+arrcwwidth+l+delta,SlideBar.Y) ; 

Shcw_Cursor(}to3S,Ypcs) ; 

Action  :=  TRUE; 
end; 
end; 


construccor  VejrticalSlideEar .  Init  ( InitX ,  InitY ,  InitColor ,  InitHilitsColor , 

InitControlColor , 
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InitHdiLiteGontrolGolor :  word; 

InitToTiim,  InitHiLim, 

Initlix::  real  ;IiutAccel:  integer) ; 

{ 

************************************************************************ 
*  * 

*  FUPPOSE  * 

*  Initialization  for  a  vertical  slide  bar  control.  * 

************************************************************************ 

} 

var 

delta: integer; 
begin 

Increment  :=  Initinc; 

Accel  :=  InitAccel; 

LoLim  :=  InitToT  .Im; 

HiLim  :=  InitHiLim: 


FixedControl.Init(InitX,  InitY,  V_BarWidth,  V_BarHeight, 

Initcolor,  InitHiLiteColor,  InitControlColor, 
InitHiliteControlColor) ; 

Up.Init(X,  Y,  V_BarWidth,  arrov^ei^t,  color, 

HiLiteColor,  ControlColor,  HiliteControlColor) ; 

Dcwn.Init(X,  Y+Hei^t-arro^ei^t,  V^BarWidth,  arro-Aieight, 
color ,  HiLiteColor ,  ControlColor,  HiliteControlColor) ; 
slideBar.Init(X+i,  Y+arro(<^ei^t+l,  Width-2,  slideheight, 

ControlColor,  HiLiteColor,  Color,  Hi  T.i teControlColor) ; 


end; 


*) 


procedure  VerticalSlideBar.Hilite(Xgos,Ypos:vord) ; 

{ 

•k  * 

*  RiRPOSE  * 

*  Method  for  a  vertical  slide  bar  control  highlii^ting.  * 

**********************ilr******************x********************?t***x***** 

} 


begin 

Up.Hilite(X|x;s,Ypcs) ; 
Dcwn.Hilite(Xpos,Ypos) ; 
SlideEar.Hilite(]&xs,Ypcs) ; 
end; 
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prx3cedure  Vertical  SlideBar .  Shew ; 

{ 

*  * 

*  PURPOSE  * 

*  Method  for  a  vertical  slide  bar  control  display.  * 

***★**************■***•*****★***********************★****************■*'**** 

} 


var 

delta:  integer; 

XX,  yy:  integer; 

begin 

get_cursorxy(xx,yy) ; 
setfillstyle(solidf ill, color) ; 
hide_cursor; 

bar(X,Y,X4Width,y+Hei^t)  ; 
setcolor(ControlColor)  ; 
rectangle(X,Y,X+Width,Y+Hei^t) ; 
show_cursor(xx,yy) ; 

Up. Show; 

Down.  Shew; 

SlideBar.Shcw; 

delta  :=  ccmputejdelta (Value, HiIii.m,IoLim,Aocel,Accelfactor, Vertical) ; 
SlideBar. MoveTo  (SlideBar. X,  Y+arrc^dieight+l+delta) ; 
end; 


(*  ><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>><><><><><><><  *) 

function  VerticalSlideBar.Action(}4>os,Ypos;wDrd)  :bcolean; 

{ 

************************************************************************** 

*  * 

*  PURPOSE  * 

*  Method  for  a  vertical  slide  bar  control  action.  * 

************************************************************************ 

} 


var 

duniiiy:  boolean; 
s:  shortstring; 

oldy , yinc , newx , newy : integer ; 
delta: integer; 

begin 

Action  :=false; 
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CASE  Aceel-OFr' 

logscale  ;  AccelP^ctbr  :=  In(HiIj.im--LoIain) /VjSlideLength; 

reverselogscale  :  AccelFactor  :=  In(HiLim-Ii5lam)/V_SlideLength; 

linearscale  :  AccelFactor  :=  (Hilim  -  IoIjim)/y_SlideLength; 

else  begin 

Accel  :=  linearscale; 

AccelFactor  :=  (HiLim  -  loLim) /V_SlideLength; 
end; 

END;  {  CASE  ) 

if  Dcwn .  Action  (3&os ,  Ypos)  then  begin 
Action  :=true; 

if  Value,- <  HiLim  .-then- 
Vaiue-^:=-Value-'+  increment; 

delta  :=  caipjtejdelta(Value, HiLim, loLim, Accel, Accelfactor, Vertical) ; 
Hide_Cursor; 

SlideBar.MoveTo(SlideBar.X,  Y+am:wheight-+14delta) ; 
Shcw_Cursor()^x>s,Ypos)  ; 

end; 


if  Up.Action(J$)os,Ypos)  then  begin 
Action:  ^'true; 
if  Value  >  LaLim  then 
Value  :=  Value  -  increment; 

delta  :=  ccmputejdelta (Value-, HiLim, loLim, Accel, Accelf actor, Vertical) ; 
Hide_Cursor; 

SlideBar.MoveTo(SlideBar.X,  Y+arra»Siei^t+l-fdelta) ; 

Shcw_Cursor  ( ,  Ypos ) ; 
end; 

if  slideBar.Action(}^x3s,Ypos)  then  begin 
Action  :=true; 
oldy  :=  Ypos; 

vMle  Lsft_Button_Down  do  begin 
G€t_CursorXY  ( newx ,  newy )  ; 

if  (newx  o  yp:>s)  OR  (newy  o  ol<^)  then  begin 
hide_cursor; 
yinc  :=  newy  -  oldy; 

if  SlideBar.Y  -r  yinc  >  Dcwn.Y  -  SlideBar. Height  -  1  then  begin 
newy  :=  olcty; 
yinc  :=  0; 
end; 

if  SlideBar.Y  +  yinc  <  Up.Y  -»•  Up.Kei^t  +  i  then  begin 
newy  :=  olcfy; 


F-98 


File  Name:  CCKCRDIS.PAS 


yinc  :=  0; 
end; 

if  yinc  o  0  then  begin 

delta  :=  SlideBar.Y  +  yinc  -  Y  -  arrcv^ieight  -  1; 
Value  :=  Trunc(HiLm  *  (delta/V_SlideLength) ) ; 
SlideBar.Movefro(SlideBar.X,  Y+arrc^ei^t+14delta) ; 

if  delta  >=  V_SlideLength~2  then 
Value  :*  HiLun; 
if  (Value  >  HiLim)  then 
Value  ;==  HiLim; 
if  Value  <  LoLim'  THEN- 
Value  :=  Lolim; 


end; 

Shcw_Cursor(X{X>s,newy) ; 
end; 

oldy  :=  newy; 
end; 
end; 
end; 

(*  ><><><>C><><><><><><><><><><><C><>CK><>0<><><><><><><>^  *) 

begin 

WindowIroageNumber  ;=  0;  (*  no  images  stored  at  start  of  program  *) 

end. 
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{****,^*'*5^****>k*******alHk********iNfc'**'********i)c*#k***i»t******itr*ftjtj!^ 


*  * 

*  PROGRAM  NAME  -  Omega  Performance  Assessnvent  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNUVNA^-  Part  of.^the'PACEOBJS  Unit  * 

*•  * 


*  ic 

*  Hiis  program  vaS'PrqMred<  tay  * 

*  ■* 

*  Bie  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  develqped  to  run  on  a  IBM  PC/AT  or  corpatible  * 

*  under  MS-DOS  3 . 3  or  hi(^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  caipatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (CNSCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 


*  HJRPOSE  * 

*  This  file  contains  the  method  for  shewing  the  coverage  * 

*  grid  information  using  the  coveragegrid  object.  * 

*  * 


* 


* 


************************************************************************ j 

Procedure  Co^'erageGrid.Shcw; 

( 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Method  to  fill  in  the  pertinent  information  on  the  coverage* 

*  cell  grid  cells,  and  then  to  display  them  along  with  the  * 

*  ajprepriate  user  selected  thresholds.  * 

************************************************************************ 


) 

VAR 

XX, yy  :  integer; 
i:  integer; 

DB102,DB136:  TimeSpecificDBFile; 
inf ol02, inf 0136:  Covcell; 

S102 ,  S13  6 ,  L102 ,1136,  D102 ,  D136 ,  A102 ,  A13  6 :  real  ; 
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St:  string; 

{ 

ardiivefile:  TineSpecificAndiiveFile; 
archiveinfo:  cellrecxjrd; 

(3X)P:  byte; 

} 

begin 

{ 

Assign  (ardiivefile,  ARCHIVEPAIH  +  'V  +  cellpcp:5)^.archivenaine)  ; 

Reset  (ardiivefile)  ; 

) 

Assign (DB102,nAIABASEPAm-'\'+DAIABASE102) ; 

Reset (DB102) ; 

Assign(DB136,DAIABASEPAIH4-'\^+DA3ABASE136)  ; 

Reset (DB136) ; 

Get_Cursorxy  (xx,yy) ; 

Hide_Cursor; 

FDR  i  ;=  1  TO  NCEIIS  DO 
begin 

{  get  the  database  data  for  each  call  and  color  it  appropriately. 

The  coloring  scheme  is  as  follows: 

SNR  -  red 

S/L  ratio  -  light  red 
Modal  -  M  in  the  cell  center 
XAngle  -  X  across  the  cell 

The  various  <±ject  variables  associated  with  a  cell  type  variable  are 
used  to  hold  flags  that  indicate  the  condition  of  the  above  threshold 
tests.  These  are  related  as  follows: 

selfptr^.abovecolor  -  SNR  or  S/L  color  (red  or  light  red  or  li^tblue  of  OK) 
selfptr'.belcwcolor  -  0  if  not  modal,  else  modal 
selfptr^.wei^t  or  coverage  -  0  if  Xangle  OK,  else  not  OK 

) 


cellarray[i]  .abovecolor  :=  iightblue; 

{  read  the  data  for  the  frequencies  selected  ) 

CASE  cellpcpn.ro^.eptr^.Freq.pic)ced  OF 
FRQ102: 
begin 

Rea<iriii«Specif  icFJxmDatabase  ( DB102 ,  i ,  sjbcellpoptro^ .  stations .  picked , 

cellpoptcr .  month ,  cellpopip'' .  hour ,  inf ol02 ) ; 

end; 

FRQ136: 

begin 

ReadrimeSpecif  icFrcmDatabase  ( DB13  6 ,  i ,  subcellpcpcp^ .  stations .  picked , 
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cellpcp:?)''  .month, cellpc^jup^  .hour,  ihfol36)  ; 

end;. 

ELSE- 

begin 

EeacflimeSpecificFraiiDatabase(DB102 ,  i,  subcellpopip^  .stations.picked, 

cellpcpqp^  .month,  cellpqpup^ .  hour,  inf ol02 ) ; 
ReadTimeSpecif icFranDatabase  ( DB13  6 ,  i ,  subcellpcpiip^ .  stations .  picked , 

ceUpcpqp^  .month,  cellpc^x^y'  .hour,  inf ol36) ; 

end; 

end;  {  CASE  ) 

{ 

ReadTimeSpecificFranArchive  (archivef  ile,  i,  cellpc^xip^  .month, 

cellpopt?>^.hour,archiveinfo) ; 

GBOE.  :=  ReadGdcp,(i,  archiyeinfo. coverage) ; 

) 

S102  ;=  Get_SNR(infol02.SNR_S)/8; 

1102  :=  Get_SNR( inf 0102. SNR_L)/8; 

D102  :=  inf 0102. Phase  AND  $7F; 

A102  ;=  infol02.X_Ang; 

S136  :=  Get_SNR(infol36.SNR_S)/8; 

L136  ;=  Get_SNR(infol36.SNR_L)/8; 

D136  :=  infol36. Phase  AND  $7F; 

A136  ;=  infol36.X_Ang; 

IF  (cellpcpi.?)^.^rtx^.Freq.picka3  =  FRQ1C2)  THEN 
begin 

if  (S102“L102  <  Rcxmd (CellPcpUp^.eptr^.ShortlongRatio. value. value) )  then 
cellarray[i]  .abovecolor  :=  Hatred; 
if  (S102  <  RDund(CellPopUpr. qjtr^. SNR. value. value) )  then 
cellarray[i]  .abovecolor  :=  red; 

IF  ((inf 0102. Phase  AND  $80)  =  0)  AND 

((D102  <=  RDund(CellP'opUpr.qptr^.PhaseDev.value. value) )  or 
(D102  >=  100  “  Round (CellPopUp''.eptr^.PhaseDev. value. value) ) )  THEN 
cellarray[i]  .belowcolor  ;=  0 
ELSE 

cellarray  [  i  ] .  belcwcclor  ;  =  255 ; 
if  (A102  >=  Round (CellPcpUp''.Krtur^.XAngle. value. value ) )  then 
cellarray [ i]  .wei^t_or_cov^ge  ;=  0 
ELSE 

cellarray [ i]  .wei^t_or_coverage  ;=  255; 

end; 

IF  (cellp:^xc>^.eptr''.Freq. picked  =  FRQ136)  THEN 
begin 

if  (S136-L136  <  Round (CellPtpUp^.Krtr^.ShortLongRatio. value. value) )  then 
cellarray [ i ] . abovecolor  : =  lightred ; 
if  (S136  <  Round (CellRxUp^.^jtr'. SNR. value. value) )  then 
cellarray [i]  .abovecolor  ;=  red; 
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IF  ((infol36.Fhase.  AND  $80)  =  0)  AND 

((D136  <=  Rouni(CellPcpUp^.^3tr^.IhaseDev.value.value))  or 
(D136  >=  100  -  Itourri(CellPcpUp^.q3tr^.rhaseDev.value.value)))  THEN 
cellarray[i].belcwcolor  :=  0 

else 

cellarray[i]  .belcwcolor  :=  255; 
if  (A136  >=  Round (CellR^ifp^.eptx^.XAngle. value. value))  then 
cellarray[i].wei^t_or_coverage  :=  0 
ELSE 

cellarray[i].wei^t_or_cx)verage  :=  255; 

end; 

IF  (cellpqx5y'.^rt:r^.Freq. picked  =  FRQCR)  THEN' 
begin 
IF  ( 

(((inf 0102. Phase  AND  $80)  =  0) 

AND 

( 

(D102  <=  Round (CellPopUp^.eptr^.FhaseDev. value. value) ) 

OR 

(D102  >=  100  -  Round(CellPopUp^. eptr^.PhaseDev.value. value) ) 

)) 

OR 

(((infol36, Phase  AND  $80)  *  0) 

AND 

( 

(D136  <=  Round (CellPopUp^.eptr^.PhaseDev. value. value) ) 

OR 

(D136  >=  100  -  Round(CellPc5^;p^. ^:tr^.IhaseDev. value. value) ) 

)) 

)  THEN 

cellarray[i]  .belcwcolor  ;=  0 
ELSE 

cellarray[i]  .belcwcolor  ;=  255; 
if  (A102  >=  RDund(CellPopUpr.eptr^.XAngle.value. value) ) 

OR  (A136  >=  Round (CellBcpUp^.eptr^.XAngle. value. value ) )  then 
cellarray[i]  .wei^t_or_cciverage  :=  0 
EISE 

cellarray  [  i  ] .  weight_or_coverage  :  =  255 ; 

end; 

IF  (cellpcpup^.^jtr^.Freq. picked  =  FRQAND)  THEN 
begin 

if  (S102-L102  <  Round (CellPc^i^.^jtr^.ShortLongRatio. value. value) ) 

AND  ( S13  6-L13  6  <  Roind  ( CellPt^^^ .  .  ShortLongRatio .  value .  value ) )  then 

cellarray [i]  .abovecolor  :=  lii^tred; 
if  (S102  <  Rcund(CellPopUp''. ^jtr'. SNR. value. value) ) 

AND  (S136  <  Round (CellPcpl^.eptr''. SNR. value. value) )  then 
cellarray[i3 .abovecolor  :=  red; 
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IF  '( 

((irrfoi02.Pha^- AND’'$80)"  =  0)’ 

AND 

( 

(D102  <=  Eound(CellPcpC^.^rtr^.FhaseDev.value.value) ) 

OR 

(D102  >=  100  “  Itound(CellPcpl^.eptr''.FhaseDev.value.value)) 

) 

AND 

((infol36'.Fhase’ AND  $80)  =  0) 

AND 

( 

(D136-  <='  Round  ( Cel-lPc53t^<' .  ^Jtr' .  IhaseDev;  value. value) ) 

OR. 

(D136  >=  100  -  Round(CellPcpPp^. eptr^.RiaseDev. value. value) ) 

) 

)  IHEN 

cellarray[i]  .belcwcolor  :=  0 
EISE 

cellarray[i]  .belcwcolor  :=  255; 
if  (A102  >=  Round(CellFopUp^. ^Jtr^.XAngle. value. value) ) 

AND  (A136  >=  Raund(CellPcpUp^. ^str'.XAngle. value; v^ue) )  then 
cellarray[i]  .wei^tjorjsoverage,  :=  0 
ELSE" 

c»llarray(i3  .weight jorjxverage  :=  255; 

end; 


{ 

IF  (GDDP  >  Round(CellPcFUp'^.^3tr^.GDOP. value. value)*10)  THEN 
cellarray[i]  .abovethreshold  ;=  TRUE 
ELSE 

cellarray[i]  .abovethreshold  ;=  FALSE; 

) 


CellArray [ i ] . Show; 
erd; 

FOR  i  :=  1  TO  NCELLS  DO 

if  CellArray [i] .Region  then 
CellArray [ i ] . ShcwRegion ; 

{  hilite  the  cell  that  was  picked  at  the  start  of  all  this  } 
cellarray [ CellPcgUp^ . HilitedCel.lPtr^ .  cellnunber ]  .hilite (xx,yy) ; 

{  now  write  scans  kind  of  legend  at  the  botton  of  the  screen  ) 
setcolor (yellow) ; 
settextjustify(lefttext,tcpta>d:) ; 
str(Round(CellPc:pUp^.epar. SNR. value. value)  ,st)  ; 
outtextxy(20,getmaxy-20, 'SNR  <  '+st+'  =  ') ; 
setfillstyle{solidfill,red) ; 
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bar(20+te3Ctwi(3th('SNR  <  '+st+'  =  ')+5,getma3Q^-20, 

20+textwidth('SNR  <  '+st+'  =  ')+25,-get3na^-2CH-textheight('l') ) ; 
str{Rcurd(CellPcpUp^.^rtx^.SH0Kri£)NC3^ATI0.value.value)  ,st) ; 
cxittext3q^(160,getinaxy-20/S/L  <  '+st+'  =  ') ; 
setfillstyle(solic3fill,lightred) ; 
bar(160+textwidth('S/L  <  '+st+'  =  '}+5,getma:5q^-20, 

16CH-textwidth('S/L  <  '+st+'  =  ')+25,getmaiQ^-2CH-textheight('l')); 
str(ItourxJ(CellPGpl^.^3tr'.XANGIE.value. value)  ,st) ; 
out±ext3£y(300,get3naxy-20, 'ANG  <  '+st+'  =  '); 
setcolor (black) ; 

line(30C>ftext:width('ANG  <  '+st+'  =  ')+5,getmaxy-20, 

30CH-textva.dth('ANG  <  '+st+'  =  ')+25,getmaxy-20+textheight('l')); 
line(30(>ftext5ddth('ANG  <  '+st+'  =  ')+25,getmaxy-20, 

300+textwidth('ANG  <  '+st+'  =  ')+5,getmaxy-20+textheight('l') ) ; 
setcolor  (yellcw)  ; 

str(Itound(CellP:55Up^.^jtr^.rbaseDev.value. value)  ,st) ; 
outtextxy(440,getmaxy-20, 'Modal  (DEV  >  '+st+')  =  '); 
setcolor (white) ; 

outtextxy ( 44 0+textwidth( 'Modal  (DEV  >  '+st+')  =  ')+5,getmaxy-20, 'M') ; 

(  added  the  frequency  to  the  coverage  display  12/18/90  GRD  ) 

CASE  CellPcpUp^.eptr^.Freq. picked  OF 
FRQ102  :  St  '10.2'; 

reQ136  :  St  ;=  '13.6'; 

FPQAND  :  St  ;=  '10.2  AND  13.6'; 

PPQOR  :  St  :=  '10.2  OR  13.6'; 

end;  {  case  } 

IF  cellpopi:?^  .hour  <  10  THEN 
Outtextxy(getroaxx  DIV  2  - 

textwidth(MonthNames[CellPopUp^.mDnth3+'  0'+HourNames[cellpopup^.hour]  + 

'00  Station:  '+'  Freq;  10.2  AND  13.6')  DIV  2,getmaxy  -  10, 

MonthNames[CellPcp(Jp^.month]+'  0'+HcurNames[cellpopup''.hour]  +'00  Station:  ' 
+stationnames  ( subcellpqpcp^ .  stations .  pic3ced] + '  Freq:  '  +st) 

ELSE 

Outtextxy(getroaxx  DIV  2  - 

textwidth(MonthNaroes[Cel]Pcpl^^.inonth]+'  '+HourNames[cellpopup''.hour3  -r 
'00  Station:  '+'  Freq:  10.2  AND  13.6')  DIV  2,c,atinaxy  -  10, 

MonthNamesrCellPcpQp^.month]+'  '+HourNames[cellpcpup^.hour]  +'00  Station:  ' 

+stationnames[subcellp::pi:?r. stations. picked] +'  Freq:  '+st) ; 

{ 

CMttextxy(getmaxx  DIV  2  - 

textwidth(MonthNanes[CellPopUp''.month]+'  '+HourNaines[cellpopup^.hourj  -r'OO  S 
MonthNames[CellPcptJp^.month]+'  '+HourNames[cellpcpup^.hour]  +'00  Station:  ' 

+stationnames  [  subcellpcpiro-  ■ .  stations .  picked  ] ) ; 


Shcw_Cursor(xx,yy) ; 
acse(DB102)  ; 
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Close (DB136) ; 

{ 

C2:o^'{arciiivef die)?; 

) 

end; 
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UNIT  CursrCbj; 

*  * 

*  FROGEAM  NAME  -  Csnega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Wortetald-cn  * 

*  * 

*  UNIT  NAME  -  CDRSROBJ  * 

*  * 

*  * 

*  Diis  program  was  pr^ared  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  lias  been  developed  to  run  on  a  lai  PC/AT  or  ccncatible  * 

*  under  MS-DCS  3.3  or  higher  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  cqnpatible  graphics  adapter  and  color  * 

*  nonitor.  This  work  was  performed  under  contract  number  * 

*  DraG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Cmega  Navigation  System  Center  (ONSCSN) ,  Alexandria,  VA.  * 

*  * 

********************'****************^lt*********************************X* 
*  * 

*  PURPOSE  * 

*  Cursor  handling  and  cursor-sensitive  object  * 

*  management  routines  used  to  generate  the  "point  and  shoot"  * 

*  type  user  interface.  * 

*  * 


******:*•★*★*************•****************************************★********  j 

INTERFACE 

USES 

Graph,  Dos,  Crt,  erricg; 

CCNST 

Click__cn_^ajtton  =  TRUE;  {  provide  an  audible  click  when  } 

{  a  mouse  button  is  d^ressed  ?  ) 


TYPE 

Cursor_}dnds  =  (arrow,  finger,  wait:) ; 


C2JST 


ENTER  =  13 ; 


{  special  ]<eys  } 
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ESC  =  27; 
BACKSPACE"*  8; 

FKEY_1  *  186; 
EKeO  *  187; 
FKEy_3  »  188; 
EKeO  *  189; 
FKEX_5  *=  190; 
FKEX_6  *  191; 
FKEX_7  *  192; 
FKEyjB  »  193; 
FKEy_9  *  194; 
EKEY_10  »  195; 

FGEN  *  208; 
PGUP  =  200; 


{  function  key  constants  } 


{  help  constants  ) 


Izn?JEUriaijeRESSED  *  l;  {  mouse  constants  ) 

KEGOT_BC7ITON_IRESSED  =  2; 

XJCNJIDIIT  =  0;  {  cursor  boundaries} 

XJffix’LTMTr  =  649; 

YJCNJIIMIT  *0;  {  cursor  boundailes) 

YJIAx'lIMIT  »  347; 

FWDJNEXrj3BIECr  *  9;  {  cursor  control  constants  } 

BFJrojJEaF^OBJECT  *  142; 

HEADJDBJICT  *  198; 

XJPJ^SXX]  »  199; 

Le5t_ARRCW  *  202; 

PI<3n'_AFPCW  »  204; 

IASr_OBJECT  =  206; 

DOWNJiFROW  =  207; 

INSEir_KEY  *  209; 

CT?L_lipr_AER:W  =  242; 

CTRLJOiGOTJiRK^f  =  243; 

CrPL_END_ARRCW  =  244; 

CERLl?Gi:j^_ARFCW  =  245; 

cmjnfElssavi  =  246; 

CmTpGOPJiERCW  =  259; 


TAR 

_Carsor_set  :  SET  OF  UPJ^RI^.  .cna.JO!EJ^I^ 
_Active_page,  _Display_Page:  vvcrd; 

H<CCEnJRE  Beep; 

PRCCSrORE  Get__Keyr^  KEY_IRESSED  :  Integer)  ; 

{  get  the  key  pressed  value  if  there  is  one  } 
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HCCEEDRE  S€t_Cursor_Shape(ckii3d:  cursorjdnds)  ; 

{  Set  the  cursor  sh^je  by  passing  kind  flag  ) 

procedure  get  CDRSOR3C^(VaR  XjCoord  :  Integer;  VAR  YjCoord  :  Integer) ; 

{  Get  the  current  cursor  coordinates  } 

EROCEDDRE  Hide_Cursor; 

{  Hide  the  cursor  -  remove  it  frtan  the  display  } 

IRDCEDURE  Showr_Cursor(X_Coord  :  Integer;  Y_Ooord  ;  Integer) ; 

{  Show  the  cursor  at  the  indicated  coordinates  of  the  cursor  '•hot  spot"  } 

IROCEDURE  MovejCursor(__Key_Pressed:  Integer;  VAR  01d_X_Coorc,  01d_Y__Coord  :  Integer) 
(  Move  the  cursor  according  to  a  the  cursor  movement  key  pressed  } 

FUNCnCN  Ieft_Button_Down:  Boolean; 

{  Indicates  whether  the  left  mouse  button  is  d^ressed  ) 

FUNdlCN  Right_3utt^_Dcwn:  Boolean; 

{  Indicates  whether  the  left  mouse  button  is  depressed  } 

FUNCncN  Get^Buttons  :  Integer; 

{  Retrieve  the  integer  r^resentation  of  the  Mouse  Button  pushed  ) 

RRCXEDURE  S€t_Cursor_Page(Pagejium:  Byte) ; 

{  Set  the  Mouse  Cursor  to  display  on  the  proper  page  ) 

IMEiaiEOTATICN 

TYRE 

Curs  =  Array[1..134]  of  byte; 

Cursptr  =  ^curs; 

curarray  =  ARRAY[0..31]  OF  word; 

CONST 

{  Seme  sample  cursor  shapes  for  multi-page  cursor  ) 

(  "Conventional"  Arrowhead  cursor  } 

Arrow__CURSQR_Ml;  Curs  =  ( 


15,  0, 

15, 

0, 

63, 

255, 

63,255, 

63,255, 

63,255, 

31,255, 

31< 

,255, 

31, 

255, 

31,255, 

15, 

255, 

15, 

255, 

15,255, 

15,255, 

7,255, 

7,255, 

7, 

,255, 

7, 

255, 

3,255, 

3, 

255, 

3, 

255, 

3,255, 

1,255, 

1,255, 

1,255, 

1, 

,255, 

0, 

255, 

0,255, 

0, 

255, 

0, 

255, 

0,127, 

0,127, 

0,127, 

0,127, 

0, 

,  63, 

0, 

63 , 

0,  63, 

0, 

63, 

0, 

31, 

0, 

31, 

0,  31, 

0,  31, 

1,255, 

,255, 

1, 

255, 

1,255, 

16, 

255, 

16, 

255, 

16,255, 

16,255, 

48,255, 

48,255, 

48, 

,255, 

48, 

255, 

248,127, 

248, 

127, 

248, 

127, 

248,: 

L27, 

248,127, 

248,127, 

248,127, 

248, 

,127, 

252, 

63 , 

252 ,  63 , 

252, 

53, 

252, 

63 , 

0, 

0) 

/ 

Arrow  cursor  'JZ 

:  Curs  = 

.  / 

15,  0, 

15, 

r\ 

2, 

0, 

0, 

0, 

0,  c. 

0,  0, 

64,  0, 

54, 

,  C, 

64, 

0, 

64,  0, 

96, 

0, 

96, 

0, 

96, 

0, 

96,  0, 

112,  0, 

112,  0, 

112, 

0, 

112, 

n 

r 

120,  0, 

120, 

0, 

120, 

0, 

120, 

0, 

124,  0, 

124,  0, 

124,  0, 

124, 

0, 

126, 

0, 
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126,  0,126,  0,126r  0,127,  0,127,  0,127,  0,127,v  0,127,128,127,128, 

127,128,127,128,127,192,127,192^127,192,127,192,124,  0,124,  0,124,  6, 

124,  0,  70,  0,  70,  0,  70,  0,  70,  0,  6,  0,  6,  0,  6,  0,  6>  0, 

3,  0,  3,  0,  3,  0,  3,  0,  3,  0,  3,  0,  3,  0,  3,  0,  1,128, 

1,128,  1,128,  1,128,  0,  0); 

{  pointing  finger  cursor  } 

FingerjCURSCRJMl:  Curs  *  ( 

IST  0,  li,  0,243, 255, 243, 255, 243, 255,243, 255, 225, 255, 225, 255, 225, 255, 
225,255,225,255,225,255,225,255,225,255,225,255,225,255,225,255,225,255, 


225,255,225,255,225,; 

255, 

225,255, 

224, 

15, 

224, 

15,224, 

15, 

224, 

15, 

224, 

1, 

224, 

1,224, 

1,224, 

1, 

224, 

0, 

224, 

0, 

224, 

0,224, 

0, 

128, 

0, 

128, 

0, 

128, 

0,128, 

0,  0, 

0, 

0, 

0, 

0, 

0, 

0, 

0,  0, 

0, 

0, 

0, 

0, 

0, 

0, 

0,  0, 

0,  0, 

0, 

0, 

0, 

0, 

0, 

0, 

1,  0, 

1, 

0, 

1, 

0, 

1, 

128, 

1,128, 

1,128, 

1, 

128, 

1, 

192, 

3, 

192, 

3,192, 

3, 

192, 

3, 

224, 

7, 

224, 

7,224, 

7,224, 

7, 

0, 

0) 

« 

t 

Finger__CURSCRJM2 

:  Curs  ’ 

“  ( 

15, 

0,  15, 

0,  12, 

0, 

12, 

0, 

12, 

0, 

12, 

0,  18, 

0, 

18, 

0, 

18, 

0, 

18, 

0,  18, 

0,  18, 

0, 

18, 

0, 

18, 

0, 

18, 

0,  18, 

0, 

18, 

0, 

18, 

.  0, 

18, 

0,  18, 

0,  18, 

0, 

18, 

0, 

19, 

240, 

19, 

240,  19, 

240, 

19, 

240, 

18, 

78, 

18, 

78,  18, 

78,  18, 

78, 

18, 

73, 

18, 

73, 

18, 

73,  18, 

73, 

114, 

9, 

114, 

?, 

114, 

9,114, 

9,144, 

1, 

144, 

1, 

144, 

1, 

144, 

1,144, 

1, 

144, 

1, 

144, 

1, 

144, 

1,128, 

1,128, 

1, 

128, 

1, 

128, 

1, 

128, 

2,128, 

2, 

128, 

2, 

128, 

2, 

64, 

2,  64, 

2,  64, 

2, 

64, 

2, 

32, 

4, 

32, 

4,  32, 

4, 

32, 

4, 

31,, 

248, 

31,248,  31,248,  31,248,  0,  0) ; 


Wait_aJRSCRJMl:  Curs  »  ( 


15, 

0,  15, 

o 

o 

o 

0, 

0, 

0, 

0, 

0, 

0, 

0, 

o 

o 

0, 

0, 

0 

0, 

0,128, 

1,128,  1, 

128, 

1, 

128, 

1, 

128, 

1, 

128, 

1,128, 

1, 

128, 

1 

192, 

3,192, 

3,192,  3, 

192, 

3, 

224, 

7, 

224, 

7, 

224, 

7,224, 

7, 

240, 

15 

240, 

15,240, 

15,240,  IS, 

248, 

31, 

248, 

31, 

248, 

31, 

248, 

31,240, 

15, 

240, 

15 

240, 

15,240, 

15,224,  7, 

224, 

7, 

224, 

7, 

224, 

7, 

192, 

3,192, 

3, 

192, 

3 

192, 

3,128, 

1,128,  1, 

128, 

1, 

128, 

1, 

128, 

1, 

128, 

1,128, 

1, 

128, 

1 

0, 

0,  0, 

0,  0,  0, 

0, 

0, 

0, 

0, 

0, 

0, 

0, 

0,  0, 

0, 

255, 

255 

255, 

255,235, 

253,255,255, 

20, 

167) 

t 

Wait  CDESCR  M2: 

Curs  =  ( 

15, 

0,  15, 

0,  0,  0, 

0, 

0, 

0, 

0, 

0, 

0, 

127, 

254,127, 

254, 

127, 

254, 

127, 

254,  32, 

4,  32,  4, 

32, 

4, 

32, 

4, 

32, 

4, 

32, 

4,  32, 

4, 

32, 

4 

19, 

200,  19, 

200,  19,200, 

19, 

200, 

15, 

240, 

15,, 

240, 

15, 

240,  15, 

240, 

7, 

224 

7, 

224,  7, 

224,  7,224, 

2, 

64, 

2, 

64, 

2, 

64, 

2, 

64,  4, 

32, 

4, 

32 

4, 

32,  4, 

32,  9,144, 

9, 

144, 

9, 

144, 

9, 

144, 

19, 

200,  19, 

200, 

19, 

200 

19, 

200,  39, 

228,  39,228, 

39, 

223, 

39, 

228, 

47,. 

244, 

47, 

244,  47, 

244, 

47, 

244 

127, 

254,127, 

254,127,254, 

127, 

254, 

0, 

0, 

0, 

0, 

0, 

0,  0, 

0, 

0, 

0 

0, 

0,  0, 

0,  0,  0, 

206, 

20) 

* 

/ 

{  Cursor  forrs  for  the  ixxse  driver  } 
{  rradiricnal  arrowhead  cursor  } 
ArrowjCURSOR  :  curarray  =  ( 
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$3FEF,  $1FFF,  $OFFF; 
$001F,  $01FF,  $10FF, 
$0000,  $4000,  $6000, 
$7FC0,  $7C00,  $4600, 


$07FF,  $03FF,  $0IFF) 
$30BF,  $FB7F,  $F87F, 
$7000,  $7800,  $7C00, 
$0600,  $0300,  $0300, 


$00EF,  $007F,'  $003F, 
$FC3F, 

$7E00,  $7FOO,  $7F80, 
$0180) ; 


{  pointing  finger  cursor  } 
f ingerjDORSCR  :  curarray  * 
$F3FF,  $EIFF,  $E1EF,  $E1FF, 
$0000,  $0000,  $0000,  $0001, 
$0C00,  $1200,  $1200,  $1200, 
$9001,  $9001,  $8001,  $8002, 


$E1FF,  $E00F, 
$8001,  $C003, 
$1200,  $13F0, 
$4002,  $2004, 


$E001,  $E000,  $8000, 
$E007, 

$124E,  $1249,  $7209, 
$1FF8)  ; 


{  Waiting  cursor  } 
Wait_CURSCR:  curarray  =  ( 
$0000,  $0000,  $8001,  $8001, 
$E007,  $C003,  $3001,  $8001, 
$0000,  $7FFE,  $2004,  $2004, 
$0990,  $13C8,  $27E4,  $2FF4, 


$C003,  $E007, 
$0000,  $0000, 
$13C8,  $0FF0, 
$7FFi:,  $0000, 


$F00F,  $F81F,  $F00F, 
$FETF, 

$07E0,  $0240,  $0420, 
$0000)  ; 


VMi 

__Saved_pixels  :  ^byte;  {  mouse  stuff  } 

_Mouse_Enabled  :  Boolean; 

_X_Point,  _Y_Point  :  Integer; 

_X_Save,  Jf_Save:  Integer; 

Cursor jnl,  Cursorjn2:  cursptr; 

Cursor_shcwflag:  Integer; 

J43use_Bttn_Count:  Byte; 

__Insert_Key__flag:  Boolean; 
mstat,  Integer; 


EPCCEDURE  Be^; 


★  * 

*  HJRPCSE  * 

*  Generate  One  1/10  Second  Besg  * 

*  * 


BEXnN 

Sound (880) ; 
Delay(lOO)  ; 
NoSound; 
2ND; 


(make  sound) 

{delay  1/10  second} 
{step  sound) 


SPCCEDUPE  Clide; 

{ 

if  X 

*  HIRPCSE  * 
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*  Malceva  clidcing' ‘sound-  for  use^.when-.a'mdusefbutdd^  pushed* 

*  * 

} 

{  MaloB  a  cliciking  sound  } 

VSR 

i  ;  Integer; 

BEXnN 

KR  i  :=  1  TO  250  DO  BEGIN 
Sound(2000fi) ; 

£ND; 

NoSound 

END; 


{library  of  MicrcSoft  mouse  interface  routines) 

EROCEDGRE  mshape(xhot,  yhot  :  Integer;  vaR  cursor  :  curarray) ; 

{ 

**•**■*★****★**★1**'*  ******************************************************* 


*  * 

*  HJRPOSE  * 

*  Set  the  mouse  cursor  shc^.  * 

*  * 


************************************************************************** 

} 

{  xhot  and  yhot  pixel  designations  for  the  cursor  hot  spot,  cursor  is 
the  array 

containing  the  cursor  shape,  curarray  is  array  type  defined  as 
ARRAY[0..31]  OF  INTEGER  ) 

lYRE 

regset  =  RECORD 

ax,  hx,  cx,  dx,  fcp,  di,  si,  ds,  es,  flags  :  Integer 
END; 

recpack  :  Registers; 


BEGIN 

WITH  recpack  DO 
BE)GIN 

ax  ;=  9; 
bx  xhct; 
cx  :=  yhot; 
dx  :=  Ofs (cursor [0 j) ; 
es  :=  Seg ( cursor fO]) 
IND; 

Intr($33,  recpack) 

END; 
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ISDCEEURE  mstatusCWiR  mstat-,  nfauttons  Integer)-'; 
{ 


* 

* 

* 

* 

* 

* 

* 


* 

PORPOSE  * 

returns  mouse  status  ani  resets  mcuse  parameters.  * 

mstat=o  if  mouse  is  not  installed.  -1  otherwise.  * 

nfauttons  is  nunsfaer  of  buttons  enabled,  *=2  for  this  program  * 

* 

* 


TXPE 

regset  =  RE03RD 

ax,  fax,  cx,  dx,  bp,  di,  si,  ds,  es,  flags  :  Integer 
END; 

VAR  recpack  ;  Registers; 


BE)GIN 

recpack.ax  ;=  0; 

Intr  ( $33 ,  recpack) ; 

WITH  recpack  DO 
BEGIN 

mstat  ;*  ax; 
nfauttons  ;»  fax 
END 

END; 

H^XSDURE  mshcw; 

{ 

************************************************************************ 


*  * 

*  FDRPOSE  * 

*  shew  the  mcuse  cursor  at  the  current  pcsition  * 

*  * 


*iMlr****'jtf****'***-****5lr***-*******Tit***'*7lr*Tit*****'*****'****'*Ttr**i«rw*?»********Tkar** 

) 

{  shew  moose  cursor  } 


TCE 

regset  =  RECORD 

ax,  fax,  cx,  dx,  hp,  di,  si,  ds,  es,  flags  ;  Ineager 
END; 

’ZaR  rec^ck  :  Regisears; 


BEGIN 

zacpaciz.ax  1; 
Intr  ($33,  recpack) 
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END; 


SGOCEEURE  idiide; 
{ 


* 

* 

* 

* 


HJKPOSE 

rescve  the  mouse  cursor  ftm  the  screen 


* 

* 

* 

* 


{  hide  mouse  cursor  } 


TYPE 

regset  «  PECQRO 

ax,  hx,  cx,  dx,  ixj,  di,  si,  ds,  es,  flags  :  Integer 
END; 

■VftR  recpack  :  Registers; 


BEXSIN 

recpack. ax  2; 
Intr($33,  recpack) 
END; 


PKXEDCJRE  mposCVAR  ndat,  mx,  my  :  Integer) ; 
{ 


*  * 

*  HJRPCSE  * 

*  returns  position  of  mouse,  coordinates  mx,  ay.  * 

*  if  mbt»l,  left  button  was  pressed  * 

*  if  Bi>t*2,  right  button  was  pressed  * 

*  if  Btot»3,  both  buttons  were  pressed  * 

*  * 


****************************•**********************:*»*************** 

) 


TYPE 

regset  **  RECTSRD 

ax,  bx,  cx,  dx,  bp,  di,  si,  ds,  es,  flags  :  Integer 
DTO; 

VRR  recpack  :  Registers; 

BEGIN 

reqack.ax  :=  3; 

Intr  ( $33 ,  recpack) ; 

WITH  recpack  CO 
BEGIN* 

met  :=  fax; 
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2K  :=  cx; 

By  :*  dx 
IND 

END; 

EECCEDORE  a?«t(BK,  ay  :  Integer) ; 

[xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 


*  * 

*  PURPOSE  .  * 

*  put  the  Bcuse  cursor  at  cooitlinates  Bsc^ay;  * 

*  legal  values  aust  he  si:;pled  * 

it  * 


) 

TYPE 

regset  *  REOS^ 

ax,  bx,  cx,  dx,  ip,  di,  si,  ds,  es,  flags  :  Integer 
END; 

VAR  recpacJc  :  Registers; 

EEXZN 

reqjack.ax  :■«  4? 
recpack.cx  :*  aix; 
reqsack.dx  ;*  ay; 

Intr($33,  recpack) 

END; 

PROCEDURE  Bivliadt(Bdjpos,  aaxpos  ;  Integer) ; 

( 

*****•***★*■***★*********>»********★***★****************■***★*★******★*★★*** 


*  * 

*  PURPOSE  * 

*  set  adn  and  aax  vertical  liadts  for  cursor  positions  * 

*  * 


iHt*****iHt»******>lt**  ****************************  **Tt********'**»t************ 

} 

TYPE 

regset  =  RECCED 

ax,  hx,  cx,  dx,  ip,  di,  si,  ds,  es,  flags  :  Inreger 
rND; 

VAR  recpadc  :  Registers; 

BEGIN 

recpadc. ax  ;=  3; 
rscpack-cx  :=  adnpcs; 
recpack.dx  ;=  saxpcs; 
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Int2r($33,  ret^a^)? 

END; 

IRXEDDRE  irihlimit(miipos,  aaxpos  :  Integer) ; 
{ 


it 

*  HJRPpSE 

♦  set  min  and  max  vertical  limits  for  cursor  positions 


* 

* 

* 

* 


TYPE 

regset  *  RECXM) 

ax,  bx,  cx,  dx,  tp,  di,  si,  ds,  es,  flags  ;  Integer 
END; 

recpadc  :  Pegisters; 

BEGIN 

reqadc.ax  :*  7; 
recpack.cx  :»  miipcs; 
recpack.dx  :«  maxpos; 

Intr($33,  recpadc) 

END; 


rPOCEDDPE  mtext(select,  maskl,  mask2  :  Integer) ; 

{ 

'k^'^it'^ititititititftititirkitititititititiiirkititititititititiHrkititieititicitititititititititirkitititicititititititititititititit 


★ 


★ 


*  PURPOSE  * 

*  select  the  text  cursor,  selects  gives  software  cursor,  * 

*  select=l  gives  hardware  cursor.  * 

*  For  selectK)  specify  screen  mask  and  cursor  mask  in  maskl,* 

*  mask2.  For  select*!,  specify  maskl*0  and  * 

*  mas2*no.  scan  lines  in  cursor  * 

*  * 


****************************************************iit******************* 

) 


TYPE 

regset  =  RECORD 

ax,  bx,  cx,  dx,  to,  di,  si,  ds,  es,  flags  :  Integer 
END; 

VMl  recpack  :  Hegiscars; 


BEGIN 

recpack.  ax  :=  10; 
recpack.cx  :=  maskl; 
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rBcpack.dx  :=‘iiiask2;. 
Intr($33,  recpack) 
END; 


PROCELURE  Mouse_Intr  (call^raitine;  pointer;  mask:  word) ; 


{ 

iri 

* 

* 

* 

* 

* 

* 

* 

* 

* 

•k 

* 

* 


VAR 


H3RP0SE 

set  a  i:iser  defined  routine  to  be  called  \4henever  certain 
events  occur 

Hask  defined  vMch  events  cause  interrupts: 

'jit  0  ~  movement  (positicn  change) 

1  <-  left  button  pressed 

2  -  left  button  released 

3  -  right  button  pressed 

4  -  right  button  released 


* 

* 

★ 

* 

* 

★ 

* 

* 

* 

* 

* 

* 


*★*★*★****■*★******★*★********★★**★************'****************★**★***★** 


recpack  :  registers; 


BEGIN 

recpack.  ax 
recpack.  cx 
recpack.  dx 
recpack.es 


12; 

mask; 

OFS  ( Call_routine' ) ; 
SEG(call_routine-^) ; 


Intr  ( $33 ,  recpack)  ; 
END; 


PROCEEURE  msetCR3page(page;byte) ; 

{ 

*'************i>t********tk*************ilt*******'*?«*»t»*iir**ilf»**ilf**»f*****'*****»r 


*  * 

*  HJRPOSE  * 

*  Set  the  mouse  GKT  page  (page  to  display  on)  * 

*  * 

*  * 


} 

VAR 

recpack  :  registers; 


BEGIN 

recpack. ax  :=  29; 
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rsc23ac}c.iKi:= 

Int3:($33,  rscpadc) ; 

END; 

FRDCEDDRE  mgetCRIi)age(VAR  pagertyte) ; 

{ 


*  * 

*  HIRPOSE  * 

*  Get  the  current  mouse  CRT  page  * 

*  * 

*  * 


) 

vaR 

recpack  ;  registers; 

HE)GIN 

recpack.ax  30; 

* 

Intr($33,  recpack) ; 

recpack.bx  page; 

END; 


I55CCSDURE  GstJ^(ym  Yn_msSED  ;  Integer)  ; 

{ 

************************************************************************ 


*  * 

*  HIRPOSE  * 

*  Retrieve  the  integer  value  of  the  keytxaard  key  pressed,  * 

*  * 

*  INHUS  * 

*  ■‘None*  * 

*  * 

*  OTEHUS  * 

*  K^_Presse!r'  * 

*  * 

*  GIDEALS  * 

*  __Demo_Flag  * 

*  * 

»  SUBTROSAMS  CAIIZD  * 

*  Daoojfey  * 

*  * 

*  REMARKS  * 

*  *Ncne»f  * 
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} 


VftR 

ASCnjDDDE  ;  Char; 

EEXHN 

(*  IF  (_DeinoJFlag)  THEN 

Key_PDessed  ;=  Demqjcey 
EESE  *) 

IF  (KeyPressed) 

IHEIT  BEGIN 

ASdljOODE  :=  ReadKey; 

IF  ord(ASCn_OODE)  =  0 

THEN  KEY^PRESSED  :=  ord(ReadKey)+l27  {  CME3GA  ACCESS  INEESNAL  CODE  } 
USE 

KEY_ERESSED  :=  ord(ASCII_OODE) ;  ' 

END 

ELSE 

KEY_ERESSED  :=  0; 

END; 


E5DCEDJRE  Set  Cursor  Sh2^(ckind:  cursorjcinds) ; 

{ 


★  * 

*  PURPCSE  * 

*  set  the  kind  of  cursor  shape  to  display  for  the  mouse  * 

*  pointer  * 

•k  * 


★**************ifc  **************** ★**★★★'**★★***★*******★★******★★***★**★** 

) 

BEGIN 

CASE  ckind  OF 
arrow:  BEGIN 

Cursor jal  :-  @Arrow_Cursor_Ml; 

Cursorjn2  :=  @Arrow__CursorJC; 
mshape(  0,0,  ArxowjCursor) ; 

END; 

finger;  BEGIN 

Cursorjnl  :=  §finger_Cursor_Ml; 

Cursor_m2  ;=  §Finger__Cursor_M2 ; 
ffishape(  0,0,  FingerjCursor) ; 

END; 

wait:  BEGIN 

Qirsorjnl  :=  §WAIT_CurscrJll; 

Cursor  m2  :=  §WAIT  Cursor  M2; 
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fflslace(;v7,0;  WM^^Qinsor)^; 
END; 

END;  {CASE} 

END; 


ERDCEDDRE  GET  cnRSCIRXY(VaR  XjOoord  :  Integer;  VAR  y_Coord  :  Integer)  ; 
{ 


*  HIRPOSE  * 

*  Get  the  current  cursor  coordinates  * 

*  * 

*  INHJES  * 

*  * 


*  OJTEUIS  * 

*  For  nonjnouse  operations,  return  the  values  of  the  global  variables  * 


*  __X_Point  and  _Y__Point 

* 

* 

4c 

*  GIDBALS 

4c 

*  _X_Point 

4c 

*  __Y_Point 

4r 

*  JiouseJEnabled 

4c 

★ 

4c 

*  SUBPROGRAMS  CAIIZD 

* 

*  npos 

4c 

************************************************************************* 


} 


VAR 

X_Mouse__Coord,  YJtfc«£e_,Coord,  ;  Integer; 


BE)GIN 

IF  (_Mouse__Enabled)  IHEN  BEGIN 

MFCS  (MJB^P,  X_MaisejCoord,  y_Mouse_Coord) ; 
XjOoord  :»  X_Mouse__Coord; 

Y_Coord  ;=  Y_Mcuse_Coord; 

_X_Point  X_Ccord; 

3_?oint  :=  Y_Coord; 

END 

ELBE  BEGIN 

XjOoord  ;=  _X_Point; 

YjCoord  ;=  _Y_Point; 

END;  ”  (IF) 


PPCCmJSE  Hide  Cursor; 

{ 

*************»w**»r3(***w:>r***************5tx'**5ic*'!if*'****w**5if*w****5t*'x*'5it****** 
*  * 
*  PURPOSE  * 
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*  Hide  the  cursor  -  reinove  it  frcni  the  di^lay  * 

*  I'tar  non-nouse  cperation,  this  procedure  restore  the  pixels  * 

*  that  were  saved  in  the  global  buffer  _Saved_Pi3cels  at  the  * 

*  last  location  vAiich  was  saved  in  _X_Point,  _Y_Point.  * 

*  * 

*  ***  Modified  for  nulti-page  operation  ***  * 

*  * 

*  INHJTS  * 

*  *Ncaie*  * 

*  * 

*  OCTmJES  * 

*  *NOne*  * 

*  * 

*  * 

*  _X_point,_y_point  * 

*  * 

*  CaiUNG  KXinNE  * 

*  Routines  vdiich  hide  the  cursor  * 

*  * 

*  SUBEWXRAMS  CATTFD  * 

*  nhide  * 

*  putpic  * 

*  REMARKS  * 

*  *NOne*  * 

*  * 


************************************************************************ 

} 

VAR 

saved  :  ViewPortIVpe? 

BEGIN 

IF  (_Mouse__Enabled) 

THEN  edgin’" 
iiihide 
END 

else  BEGIN 

Dec(Cursor_Showflag) ; 

IF  Cursor_Showflag  =  -1  THEN  BEGIN 
GetViewSettings  (saved) ; 

SetViewPort(0,  0,  639,  349,  cl^ff) ; 

IF  _Active_Page  o  _Di^lay_Page  IHEN  SetActivePage(JDi^lay_Page) 
Putlniage(_X_Save,  Jl_Ssve,  JSavedJPixels^,  Normalput) ; 

IF  __ActiveJPage  o  _pisplay_Page  THEN  SetActiv^ge(_Active_Page) ; 
VLEEH  saved  DO  SetViewPort(xl,  yl,  x2,  y2,  clip); 

END; 

END; 

END; 
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IRCCEEDRE  Shc»MCursor(X_Ccord  :  Integer;  YjQaord  :  Integ^)  ; 
{ 


*  * 

*  PURPOSE  * 

*  Show  the  cursor  at  the  indicated  coordinates  of  the  cursor  "hot  spot"* 

*  DPEftlED  KR  IUrbo  4.0  * 

*  * 

*  ***  Modified  for  multi-page  display  ***  * 

*  .  '  * 

*  INH7IS  * 

*  Current  X  and  Y  coordinates  of  cursor.  * 

*  * 

*  OOTPOTS  * 

*  Cursor  displayaa  at  currant  X  and  Y  coordinates  of  cursor.  * 

*  ★ 

*  GLDBAIS  * 

*  For  non-mouse  operation  the  following  glctoal  variables  are  set;  * 

*  * 

*  _X__Point,  _Y_Point  coordinates  of  currant  cursor  hot  spot  .  * 

*  __Saved_Pixels  copy  of  pixels  which  were  under  the  cursor  * 

*  (used  by  HTDEjCURSCR  to  restore  screen  area)  * 

*  * 

★  * 

*  SUBERDGRftMS  CailED  * 

*  GETIMftGE  * 

*  PUnMRGE  * 

*  itput  * 

*  mshcw  * 


************************************************************************** 

) 


saved  :  viewporttype; 


set  the  global  variables  } 
if  .necessary  } 

IF  _X_Point  >  XJ^AX_LIMrT 
THEN  JC_?oint  ;=  XJdax_IJHrr; 

IF  _X_Point  <  XJ[IN_nEHn' 

THEN  _X_?oint  :=  X_MIN_IJ1!IT7 
IF  _Y~?oinc  >  YJ®X_I1MT 
THEN  Y  Point  ;=  Y  .MAX  LIMIT; 


BEGIN 

_X_Point  :*  X_Coord;  { 

_Y_Point  :=  Y_Ccord7 
{  limit  the  excursicn  of  the  cursor 
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IF  _x_Foint  <  yjirN_iJMrr 
TEJEN  _y_Point  ;=  YJEENJUMIT; 

IF  (__MouseJEnabled) 

THEN  begin” 

aput(JX_Point,  _Y_Point) ; 
mshcw; 

END 

else  begin 

Inc(Qitsor_Shcwflag) ; 

IF  Cursor_Showflag  *  0  THEN  BEUHN 

{  ocpy  pixels  in  area  art  new  X,Y  to  saved  pixel- buffer  ) 
GetViewSettings  (saved) ; 

SetViewBortCO,  0,  639,  349,  clipoff)  ; 

IF  _Active_Page  o  _Di^lay__Page  THEN  SetActivePage(_Display_Page) ; 
GetIinage(JC_Point,  __Y__Point,  (_X_Point+15) , 

(Jf_Point+l5) ,  jSaved_Pi}ffils'') ; 

JXjSave  :=  JMPoint? 

_Y_Save  :=  _YJ?oint; 

{  put  the  two  cursor  masxs  over  tfe  rcxeen  } 

PutIfflage(_XJPoint,  _Y_Point,  CDPSCR_i-J.'' ,  Andput) ; 

Putlmage(__X__Point,  ^YJPoint,  OJRSCRJC^,  CSE^xrt) ; 

WITH  saved  DO  SetViewPort(xl,  yl,  x2,  y2,  clip); 

IF  _ActiveJPage  o  _Display_Page  THEN  SetArtivePage(_Active_Page) ; 
END; 

END;  {IF} 

END; 


IHOCEEURE  Mcve^ Cursor (_K^_Pressed;  Integer;  VAR  Old__X_Coord,  01d_Y_Coord  :  Integer)  ; 

*****★*★★***★*****  ******************ilt*:/lt***************************'****** 


*  * 

*  HMOSE  * 

*  Move  the  cursor  according  to  a  -the  cursor  movement  key  * 

*  pressed.  Arrow  keys  move  -the  cursor  by  8  pixels,  Ctrl  * 

*  arrow  keys  move  the  cursor  by  one  pixel.  * 

*  * 

*  * 

*  INPOTS  * 

*  *None*  * 

*  * 

*  a’TRTIS  * 

*  •*Ncn€*  * 

*  * 

*  GIDEALS 

*  Xev  Pressed  * 

*  HEAD~OElECr  * 
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lASTJDBJECr  * 

*  ■  HTOJJEXrjDBIBGr^  * 

*  BKWDJEXTJDBJECT  * 

*  JJP JSPa»  * 

*  RIGar_ARRCW  * 

*  lEPTM^RCIW  * 

*  1X)WNJ®R0W  * 

*  * 

*  CAIUNG  RXJrrNE  * 

*  aCMAIN  * 

*  * 


*  SUEERDGRAH5  CMIZD 

*  OJRSCRJDDJDBJECT 

*  RFffP 

*  HidejCursor 

*  Show__02rsor 

* 


* 

* 

* 

★ 

* 

* 


*  REWaRKS 

*  *None* 

■k 


* 

* 

* 


************************************************************************** 


} 

VKR 

X^Coord,  YjSXJrd  :  Integer; 


BEGIN 

XjOoord  ;»  Old^XjCoord; 

YjCcxad  ;*  01d__Y__Coord; 

CASE  _Key;_Kressed  OF 

UP~ARFOW  ;  BEGIN  {UP  ARROW) 

IF  (_Insert_Key_Flag)  THEN 
BEJGIN 

Y_Cdord  :=  01d_y_Coord-l; 
X_Coord  ;=  01d__X_Coord 
END 
EISE 
BEGIN 

YJDoord  01d_Y_Ctord-12 ; 
X_Coord  :=  01d_X_Coord; 
END 


EiTO; 

RI(3ir_ARRCW  ;  BEGIN  {RIGC  ARROW) 

IF  {_Insert_X^_Flag)  ISEN 
BEGIN 


X_Ccord  :=  01d__X__Ccorn+i; 
YjCoord  ;=  Old__Y_Ccx3rd 
SND 


ELSE 


BEGIN 
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Xj3oord  <-:=:  Old_X^Coqrtifl27. 
yjCoord  :*  OldjTcoora; 
END 


lEPT  ARROW 


DOWN  ARROW 


£ND; 

BEX3IN  {LEFT  ARROW} 

IF  (_InsertKey_Flag)  THEN 
BEGIN 

XjCoord  :«  OldJCjDoord-1; 
YjCoord  :»  01drY_Q3ord 
END 
•FT.crp 

BEGIN 

XjD»rd  :*  01dJ{_Coord“12; 
YjOoord  :*  01d__YjCoorti 
END  “ 


END; 

BEGIN  (DOWN  ARRCW) 

IF  (_InsertJCBy_Flag)  THEN 
BEGIN 

Y_Coord  :»  01d__Y_CoordH; 
XjCocand  :*  OldJCjDoord 
END  ” 

ELSE 

BEGIN 


Y_Coord  ;»  01d_Y_Coort3+12; 
XjCoord  :»  OldJCjCoord 


END; 

INSERT_KEY;  _I]:sert_Key_Flag  NCT(_Irisert_Key_Flag) ; 
ELSE  BEGIN 


BEEP; 

END; 

END;  (CASE) 


Hide__Cursor; 

Shcxi;_Cursor(X_Ccord,  Y_Ccord) ; 

01d_XjCoord  ;=»  XjCcord; 
OldjTcoord  :*  Y~Coord; 


END; 


FUNdTCN  Left  Bucton  Down;  Bcolean; 


\ 


Purpose 

Ri^rts  whether  the  left  reuse  button  is 
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d^resseii.  Retajrns.  ISLIE-^if  it  -is  :dcwn'^ 
EftlSE  otherwise- 


} 

VSR 

Tri t-i ai_Mfxisejaittm__Pushed  :  Integer; 

XJMouse_poord,  YJ(4xise_ax)rd:  Integer; 

BEGIN 

IF  (JCU5E_aiABIED)  IHEN  BEGIN 

Initial Jtfcuse_Buttcr\_Pushed  :*  0; 

MPOS(Initial_Mause_ButtonJPushed,  XJfausejGoord,  Y_Mcxise__Coord) ; 
IF  (InitialJMouseJButtcn^^  »  Ieft_ButtonJPressed)  HffiN 
Ifift^ButtonJDown  :«  TREE 
ELSE 

LBft_BiittonJDown  :*  FALSE; 

END 

ELSE 

Ieft__Button_Down  ;=*  FALSE; 

END? 


FUNCnCN  Right  Button  Down:  Boolean; 

{ 

Purpose 

Reports  whether  the  Right  mouse  button  is 
depressed.  Returns  TREE  if  it  is  down, 

FALSE  otherwise 

***********'******'**************'5«'^!****'*llt*******************ir>C* 

} 

VAR 

InitialJMouse_Button_Pushed  :  Integer; 

X_Moa5:e__Coord,  Y_Mcuse_Coord;  Integer; 

BEGIN 

IF  ( JE0SE_ENABLZD)  UJEN  BEGDI 

Initial_Mcuse_Button_?u3hed  ;■»  0; 

MPCS(Initial_Mi:use__Bucton_Pushed,  X_Mcuse_Ccord,  Y_Mcuse_Coord) ; 
IF  (ImtialJilouse_Button__Pushed  =  Right_Butcon_Pressed)  IHEN 
Ri^bt_Button_Dcwn  :=  TREE 
?rr<?y!  ” 

Ri^t__Button_Down  :-  FALSE; 

END 

ELSE 

Right_Button_Down  :=  FALSE;  ' 


rENCnCN  Get_Buttons  :  Integer; 
{ 
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*  H3RP0SE-  * 

*  Betrieve  the  integer  representation  of  the  Mouse  * 

*  Button  Pushed  while  "debouncing*'  the  mouse  buttons,  * 

*  A  constantly  held  button  has  no  meaning,  making  the  * 

*  butttcn  respond  vAien  it  is  released.  * 

*  * 

*  INPUTS  * 

*  Initial J4xis«JButton__Pushed,Mouse_Button_Pushed  * 

*  * 

*  ounuis  * 

*  Get_Buttons  * 

*  * 

*  GIDBALS  * 

*  ICUSE^ENABIZD  * 

*  cij:GrcN_3urrcN  * 

*  * 

*  CALLING  POUnNE  * 

*  Utility  * 

*  * 

*  SUBPROGRAMS  CALLED  * 

*  MFCS  * 

*  * 

*  RD1ARKS  * 

*  *None*  * 

*  * 


) 

VAR 

IratialJfcuse__Button_Pushed,  Mouse_Button_Pjshed  ;  Integer; 

XJtousejCoord,  YJfcusejCoord,  i  ;  Integer; 

BEGIN 

IP  (JCUSE_ENABLED)  THEN  EEGIN 

Initial J4ouse_Bucton_Pushed  ;=  0; 

MECS(Initial_Mcuse__Bucton__Pushed,  X_Mouse_Coord,  YJ43Use__Coord) ; 

IF  (Initial Jracuse_aitton_.Pushed  >  6)  THEN  BEGH^  (*M:XJSE  BUTia^  PUSHED*) 

CASE  JMcuseJBttnjCount  OF 
0;  _Mouse_Bttn__Count  :*  1; 

1;  BEGIN 

Inc(_Jfcuse__Bttn_Ccunt) ; 
i  :=  1; 

muz  a  <  10)  AND  (Lnitial_Mcuse_aictcn_?ushed  >  0)  CO  BEGIN 
L-o:(i)  ; 

D*lay{50) ; 

MPCS(  Initial J&use_3ucton__^?ushed,  X_Mouse__Ccord,  Y_Mouse_Ccord 
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END;. 

END; 

2:  Delay(50); 

END;  {CASE} 

MPOS(InitialJfcuse_Buttm_Push^  X_IfciusejCcord,  Y__MousejCtoord) ; 
END  ” 

ELSE  Jic«seJjt±n_OcuiTt  :=  0; 

GetJButtons  ;*  IrdtiaI,Jfotae^But±on_^ 

IF  CIICKJ3N_.BC7][TON  AND  (IrutialJMouse_ButtonJ5us^  o  0)  THEN 
Clide; 


END  (IF  THEN) 

ELSE 

Get  Buttons  :*  0; 


END; 


HRCCECURE  Set_Cursor_Page(Page_num:Syte) ; 

{ 

irkirkitiiiiiHiiHtiiirk'kitiiitiHtiiirirkitiiitnitiiitiiititiiititititiiititititltititititititititit'nititititit'iiititititiiitrkitii-k-k 


*  * 

*  HJRPOSE  * 

*  Set  the  Mouse  Cursor  to  display  on  the  proper  page  * 

*  * 

*  * 


************************************************************************* 

) 

BEGIN 

IF  Jtouse^Enabled  IHEN 
insetCRQage(PagejTum) ; 

END; 


{  Unit  Initialization  stuff  } 
BEGIN 

_Active__Page  :=  0; 
_pisplay__Page  :=  0; 
SetjCursor_Page(_Display.jage) ; 


_Cursor_set  :=  [FWDJffiXTjDEJECT,  HKKDJffiXTjOBIECT,  HEAD  OBJECT,  UPJiHEOT, 
IZFr_AKECW,  KrQ3TJiRRCW,~LAS?_.OBJECr,~D:«^^^  INSEET_KEY, 
CrRL_IEFr_AHECSv. .  CIPL_HC3«E_Ai^]  ; 

Cursor_showflag  :=  -i; 

_Insert_:'fey_?lag  :■=  EAISE; 

Set_Cursor_ShaEe  (Arrow)  ; 

Getifem( jSavedJPixels ,  SizeOf  (Curs)  ) ; 
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{  dieck  on  the  availability-  of  the  mouse  and'  initialize,  dt  for  our  us  } 
instatus(itistat,  ;  {imtialize.  mouses  driver} 

IF  (mstat  =  -1)  "" 

THEN  BEGIN 

_Mouse_Enabled  :=  True; 
invlimit(YjaN_.LIMIT,  (yjiAXj:iMIT-2) )  ? 
nhlimt(XJI[N_LIMIT,  (XJJMrLIMrr-2) )  ; 

END 

ELSE  _Mouse_Enabled  ;=  False; 

{  Object  initialization  ) 

END. 
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Unit  DftTMDTIL; 


* 


* 


*  I3?CC3?aM  NfyME  -  Cinega  Perfcannance  Assessment  * 

*  and  * 

*  Ccwerage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 


*  UNIT  NAME  -  DAIMJTIL  * 

*  * 


*  * 

*  Hus  paregram  was  prepared  by  * 

*  * 

*  Hie  Analytic  Science  Corporation  (TASC)  * 

*  55  Wal3<ers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  ccnpatible  * 

*  under  MS-DOS  3.3  or  higher  with  a  ittiniinum  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccnpatible  graphics  adapter  and  color  * 

*  monitor.  Hiis  work  was  performed  under  contract  number  * 

*  DKJS23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  CSnega  Navigation  System  Center  (CNSCEN) ,  Alexandria,  VA.  * 

*  * 


ii****it**ieirk***it*it***itirirk*it***itiiifk**itit*ii****it*it*it***1t1fk*it*******ii*****it*it 


*  * 

*  HJRPCSE  * 

*  Hiis  unit  contains  the  cell  format  and  archive  file  * 

*  format  declarations  as  well  as  a  collection  of  routines  * 

*  that  are  used  to  read  data  fran  the  cell  format  signal  * 

*  database  as  well  as  to  read  and  write  the  archive  files.  * 


*************************************************************************  j 

Interface 
Uses  Pacelnit; 

^  **********w»**'»t*r*:»*»'*********»'*»*»'*irx*'jlt***w***»'**'»**»f***')it**jei»'*'»->t**'x'srw********** 
*  * 


* 

* 


PACE  cell  database  and  Archive  File  Data  Definitions  and  routines  * 

•k 


ver  0  5/29/90  KATench  * 

ver  1  6/7/90  GPDesrochers  'Unitized'  the  routines  * 


) 


T!£3^ 

{  cell  coverage  informaticn  for  1  sta/month/hr} 

CovCell  =  RECCPD 

SNR_S:  Integer;  ;  Short-path  SNR  (db*8)  w/  Sigma_S  in  uppermost  nybble  (db^S) 
SNR___L;  Integer;  i  long-path  SNR  (db*8)  w/  nothing  in  urpermcst  nybble  } 
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Eha^:-  Byte;  {  aia^apeviatlCTi-.  with.- mode  •  1  flags^in- .tcpxbit  (O^fcde  1)  } 
X_Ang:  Byte;  {  Crossing  Angle  ) 

END; 


{  record  for  disk  I/O  -  4  months,  24  hours  of  coverage  information  } 

{  Disk  file  is  organized  as  8  stations  worth  of  coviorec  for  each  of  444  cells  } 
coviorBC_4m  *  array[1..4,1..24]  of  CovCell; 

coviorBC_12m  »  array[1..12,1..24]  of  CovCell;  {  12  month  version  ) 

StationCoverageinfoPtr  »  '^StationCoveragelnfo; 

StationOoveragelnfo  «  AR1RAY[1. .8,1. .12,1..24]  OF  CovCell; 

DBFile  »  File  of  StationOoveragelnfo; 

TimeSpecificDBFile  »  File  of  CovCell; 

(  Noise  data  information  for  1  month/hr  } 

NoiseCell  *  RECORD 

Sigma_N:  Eyte;  {  Noise  standard  deviation  (db*8)  } 

Noise:  Eyte;  {  Noise  value  (db*8)  ) 

END; 


{  record  for  disk  I/O  -  12  months,  24  hcurs  of  noise  information  ) 

{  Disk  file  is  organdLzed  as  444  cells  worth  of  noiseiorec  } 
noiseiorec  *  array[l. .12,1..243  of  CovCell; 

CellPecord  »  record 

Pat:  single; 

Coverage:  byte; 

end; 

ArchivedCellType  =  ArrayC1..12,1..243  of  CellRecord; 

TimeSpecificArchiveFile  «  File  of  cellrecord; 

ArthiveFile  *  File  OF  ArchivedCelliype^ 

{  Routines  to  access  the  archived  file  info  } 

procedure  StoreCellTcArthiveCVAR  AF:  Archivefile;  cellnumber:  integer; 

Cel,  1  Tnfo;ArchivedCellType) ; 

procedure  LoadCellFronArchive (VAR  AF:  Aixhivefile;  cellnumber:  integer; 

VAR  CellInfo:ArchivedCelliype) ; 

procedure  ReadlimeSpecif icFixtnArchive (VAR  AF;  TimeSpecificArchiveFile;  cellnumber, 

month, hour:  Icngint; 

VAR  arthiveinfo:  csllrecord) ; 


{  Routines  to  pack  and  unpack  the  fields  of  CovCell  } 
FUNCnCN  Pack_SNR (Sigma,  SNR;Intsger) :  Integer; 

HJNCFIOT  Get_SNR(SNR_in:Integer  ) :  Integer; 

FUNCnCN  Get_Sigma(SNR_in;  Integer);  Integer; 

Procedure  ReadFronDatabase (^7AR  DB:OBFile;callnum;  integer; 
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VftR'^covparaIl!s :  stotioncpver^e^^OTte^^ 
prboeaiire- -Re^imeSpecif icffixinDatab^  (VKR  'DBr-TimeSp^if icDBFile ; 

CellNum,  static)n,month,hour:  longint ; 
VRR  TlmeSpecificInfo: CovCtell)  ; 

Function  i<eadGdop(cftllnum>ooverage:l(aigint) :  byte; 


Inplesnentation 


JUNCnc*!  rack_SNR(Sigma,  SNR: Integer) :  Integer; 

{ 

*  PDRPCSE  * 

*  Pack  the  sigma  value  into  top  nibble  of  the  SNR  word  in  the* 

*  cell  fonnat  signal  database.  Hie  sigma  value  is  actually  * 

*  half  of  the  mo^  1  doninance  margin  byte  valije  * 

*  as  documented  in  the  PACE  final  r^rt.  Ihe  variable  called* 

*  sigma  is  shifted  left  by  12  bits  and  ORed  into  the  SNR  * 

*  value,  * 

************************************************************************* 

} 

BEXIEN 

Pack^SNR  ;*  ((Sigma-12)  SHL  12)  OR  (  SNR  AND  $IFF) ;  {12  *  1.5*8  db) 

END; 


($R-) 

FUNCnCN  Get  SNR(SNR  in: Integer  ) :  Integer; 

{ 

************************H********1lt************************************** 
*  * 

*  PURPOSE  * 

*  Remove  the  Icwer  three  nil±>les  of  information  frcm  a  word  * 

*  length  variable  with  a  quantity  packed  into  the  upper  * 

*  nibble  (the  vpper  four  bits) .  Sign  extend  by  filling  in  * 

*  the  upper  nibble  with  ones  if  the  upper  bit  of  the  third  * 

*  nibble  (bit  #  12  is  set), 
**********»***********★***<>****»**************************************** 

) 

(  remove  the  top  nybble  and  sign  extend  to  make  a  full  integer  ) 

BEGIN 

SNR_in  :=  SNR_in  AND  $FFF; 

IF  (SNR_in  AND  $300)  o  0  ?IiEN  {  Need  to  extend  sign  bit  ?  ) 

Get:_SNR  :=  SNR_in  OR  $r000 
ELSE 

Get_SNR  SNR_in; 

END; 


FUNCnCN  G€t_Sigma(SNR_in:  Integer) :  Integer; 
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**********************<H^****1t* ****************************************** 


* 

* 

* 

* 

* 


HJKPOSE  * 

Pesnove  the  value  stored  in  the  r?:per  nibble  of  a  word  valiae* 
ky  fflasking  off  the  lower  12  bits  and  then  shifting  the  * 
result  ric^  by  12.  * 


} 

(  Ejctract  sigma  fran  top  nitible  ) 

BEXHU 

Get^Sigma  :=  ((SNR_in  AND  $F000)  SHR  12)  +12; 
END; 


{$R*-) 


{  as  in  1.5*8  =  12  ) 


Procedure  ReadFranDatabase(VAR  DB:DBFile;cellnum: integer; 

VAR  covparamsrstationcoverageinfcptr)  ; 


{ 


*  * 

*  HJRPOSE  * 

*  This  procedure  reads  an  entire  cellos  worth  (over  station,  * 

*  month  and  hour)  of  signal  information  fTcan  the  cell  * 

*  format  signal  database.  * 


************************************************************************ 

} 

begin 

{  use  sane  global  unit  variables  of  type  file  to  hold  the 
database  file  handles.  Just  access  them  here  for  effeciency 
saJce,  open  and  close  them  in  coipute^Psa. 

THIS  PROCEEDRE  ASSUMES  THAT  THE  DATABASE  FILE  IS  AIPEADY 
OPENED  AS  A  FILE  OF  TYPE  DBFUZ  I !  I ! ! !  i  I  i  i ! !  1 ! ! !  I !  } 


seek{DB,cellnum-l) ; 
read(DB,ccvparams'') ; 


end; 


procedure  ReadTimeSpecif iclFranDatabase  (VAR  DB;TimeSpecificDBFile; 

CellNum ,  station ,  month ,  hour :  longint ; 

VAR  TimeSoecificInf o:  CovCell)  ; 

{ 

************************  *'*******»****************9t***:****************'»*** 


*  * 

*  HJRPCSE  * 

*  This  procedure  reads  a  cell/station/mcnth/time  specific  * 

*  record  of  signal  information  from  the  call  » 

*  format  sigr^al  database.  * 
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vaR 

index:  lon^int; 
begin 

(  use  sane  global  unit  Vcuoables  of  type  file  to  hold  the 
databa.se  file  handles.  Just  access  them  here  for  effeciency 
sake,  open  and  close  then  elsewhere. 

OHIS  PROCEnjRE  ASSUMES  IHaT  Cffi  DATABASE  FIIE  IS  ALREADY 
OPENED  AS  A  FILE  OF  TXEE  TIMESEECmCDBFILE  1 ! !  1 1 1 !  1 11  U  1 !  J !  I !  } 

index  :=  ( (oellnum-l)  *8*3:2*24)  +  ( (station-l)  *12*24)  + 
((inonth-l)*24)  +  (hour-1); 
seek(DB,  index) ; 
rBad(DB,TiitisSpecificInfo) ; 


procedure  LoadCellFratAr=hive(VAR  AF:  Arcfaivefile;  cellnumber:  integer; 

VAR  CelllnfozArchivedCellType) ; 

{ 

itirkikitititirirkititirirkitititititirkitititifititifitiHrk’itirkititititMitieitiHtititieifitkititicititititititieiticitititiciticic 
★  * 

*  PURPOSE  * 

*  Reads  a  cell's  worth  of  archived  scenario  information  from  * 

*  an  archive  file.  * 

**************************5lr********  ************************************* 

) 

(**★★**  jrcTE;  this  procedure  assumes  that  the  archive  file  is  already 
cpenedl 1 1 1 1 1 1 1  ***********) 

VAR 

i,j; integer; 
begin 

{  seek  into  the  archive  file  past  the  ccanment  and  parameters 
area  to  the  correct  cell  and  month/hcur  location  } 

{  cell  location  0  holds  the  conment  and  parameters  area  ) 

Seek(AF,  cellnumber) ; 
read(AF,CellInfo)  ; 
end; 

(V***'********************-************************************'***********7C**'*^ 

procedure  StoreCel IToArchive  (VAR  AF:  Archivefile;  cellnumber;  integer; 

CellInfo:ArchivedCeil!iype)  ; 

( 

**'»t'»t*****'**'*t**-»***»»*'***'**'5«  *■**■»*•»»***■*  *****X***»t1«*'**»f*'****»*9t****1l(»'»t**1Hr 


FJRFCSE 
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*  Writes- a -cell's  vjorth  of  ardiived^scenarip-information  to  * 

*  an-areiiive  file^  * 

************************************************************************ 

} 

begin 

(  seek  into  the  archive  file  past  the  canment  and  parameters 
area  to  the  correct  cell  and  month/hour  location  } 

{  cell  location  0  holds  the  cccanent  airi  parameters  area  } 
Se^(AF,oe],lnurriber) ; 
write  (AF,  CeT  1  Info) ; 
end; 


(**********'***'*********************^k****************************************j 

procedure  Eea(irimeSpecificFrcinArchive(VaR  AF;  TimeSpecificArchiveFile;  cellnumber, 

month, hour:  longint; 

VAR  archiveinfo:  cellrecord) ; 

{ 


*  ★ 

*  HIRPCSE  * 

*  Reads  a  cell/month/time  specific  record  of  archived  * 

*  scenario  information  to  fran  an  archive  file.  * 


******************'***********1lM**********************'******************** 

} 

VAR 

index;  longint; 
begin 

index  ;=  ( (cell number  -1) *12*24)  +  ((Tnonth-l)*24)  +  (hour-1); 
seek(AF,  index) ; 
read  (AF ,  archiveinfo) ; 
erri; 


^****************:»i**************************1lt******************************'*) 

Function  ReadGdcp(cellnum,coverage;longint) ;  byte; 

{ 

**it***it***1iirirkiriiiiii*iiic-tfk**iiii**irkii***it******it*it*************ii*ic*****ifk-k*ie* 


*  * 

*  HJRPOSE  * 

*  Reads  the  GDOP  for  the  particular  cell  and  coverage  * 

*  vector  provided  from  the  C3X)P  database  file.  * 


*'**i»************'**'>lrx**»**yr***'**i(r»*******'***'*****»********ilr*'************* 

} 

VAR 

index;  longint; 

GIXDPFile  :  file  of  byte; 
tanpresulc;  byte; 
begin 
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-{ (caHriun^lO~*256)i4^cqv^^V 
j^i^(GI»EFile,PACEPimiK'\^-^PQ?^^  ‘ 
Peset((3X)PFile) ; 

{  get  to  the  a^rcprlate  cell/ooverage  byte  of  the  file  ) 
sedc({330PFile,  index)  ; 
reed  (gPPFile,  tenpresult)  ; 
close (GDOPFile) ; 

ReedGdcp  :=  tenpresult; 
end; 

begin 

end. 
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* 

* 

•k 

* 

* 

* 

* 

* 

* 


WCCSMi  NAME  -  Omega  Performance  Assessment 

and 

Coverage  Evaluation 
(PACE) 

Workstation 

DNIT  NAME  -  Part  of  the  PACEOBJS  Unit 


* 

* 

* 

* 

* 

■k 

* 

* 

* 


************************************************************************ 


*  * 

*  Ihis  program  was  prepared  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  walkers  Brook  Drive  * 

*  Beading,  Massadiusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  ccaipatible  * 

*  under  MS-DCS  3.3  or  higher  with  a  mixumum  of  640K  of  main  * 

*  memory  and  an  EGA  or  cccpatible  grephics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  Dr0G23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Onega  Navigation  System  Center  (CNSCEN) ,  Alexandria,  VA.  * 

*  ★ 


************************************************************************ 


* 


* 


* 

X 

* 

* 

* 

★ 


HJPPOSE  * 

This  file  contains  a  collection  of  the  object  definitions  * 
whose  implementation  code  is  found  in  the  various  PACEOBJS  * 
Unit  files.  Also  included  here  are  some  of  the  global  PACE  * 
variables  and  constants  that  are  used  by  the  various  * 

objects  * 


*********************5lHt************  *************************************  J 


{*  include  file  for  pacecbjs.pas  EMA  10/4/90  *) 


const 

(*  the  maximum  list  size,  used  in  Imenu  for  the  directory  list  *) 
maxlistsize  =  10; 


(*  Global  boolean  flags  which  are  used  in  displaying  the  *) 
(*  rextstring  for  the  EditButton  *) 

ShowCursor  =  TEUE; 

HideTheCursor  =  FALSE; 

Pyri  vp.Rrtrt’ane;  =  12; 
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Maxtpij3i^Pid®ittohs^>^ 
jlaxIASEDM^sageBmd^j^ 
PPQ102  *  1; 

IPQ136  *  2; 

PROAND  *  3; 

FPOOR  *  4; 

PSARAN  *  1; 

PSADBT  =  2; 

EMDFF  *  1; 

HCN  «  2? 

SRMEEST  =  1; 

SPMNCM  *  2? 

SPMWRST  *  3; 

PSAMIN  «  1; 

PSAMEAN  *  2; 

PSAMAX  »  3; 


MonthNames:  ARRAy[1..12]  OF  shortstrirg  * 

( 'Jan' ,  'Feb' ,  'Mar' ,  'Apr' ,  'May' ,  'Jun' , 
'Jul'/Ai^'/Sep'/Cc±'/Nov','i:ec')  ; 

MA  :  AERAyCl**12]  OF  CHAR  -  * 

( ' J' ,  'F' ,  'M' ,  'A' ,  'M' , ' J' , ' J' ,  'A' ,  'S' ,  'O' ,  'N' ,  'D' )  ; 

HourNames;  ARRAy[1..24]  OF  Shortstring  » 

('l','2','3'/4','5'/6','7','8','9','10', 

'11', '12' /13', '14' /IS', '16', '17', '18', '19', 

'20', '21', '22', '23', '24'); 

StaticsiNaroes  :  arrayCl.,8]  OF  shortstring  » 

( 'A' ,  'B' ,  'C' ,  'D' ,  'E' ,  'F' ,  'G' ,  'H') ; 

IZFTDEFAIILJEARCHIVE  «  'IZPnEMP,9@@' ; 

PIGHITEEAUIIISiRCKIVE  =  'RIGSIEMP.@@@' ; 

type 

(*  for  the  Memo  Area  -  4  lines  of  text  @  50  characters  per  line  *) 
MemcOtextiype  «  ArrayCl.  .4]  of  String[50]; 

savedparamsrecort^Ar  =  ^savedparamsrscori; 
savet^saramsrecord  =  record 

Psa,SNR,ShortLan^tio,XAngle,IhaseDev,(3X)P:  real; 

Iltoff ,  EMon,  SRMbest  ,SRMncin,  SRMworst  ,I'ri02 ,  Frl36 ,  FrAND,  FrOr , 
{PsaDEr,PsaRAN,  }PsaMIN,PsaMEAN,PsaMAX;bcolean; 

Hoicked, SI^ic3ced,Frpicked{,PsaCalpidced},?saR£OTic3cad;  integer; 
StationPcwer:  ARRAY[1..83  OF  real; 

StatiorPcwerOn,StationPcwerOff:  ARRAY[1.  .8]  OF  Boolean; 
ItoTChS^lectors:  ARRAY[1.  .12]  OF  boolean; 

HcurSelectors;  ARRAyri..243  OF  &»lean; 

QRFile,Wei^tsFile;  string; 
end; 
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(***********  NOTE:  the  following  type  definition  for  camnentareatype  MUST  be 
consistenfe^-witH  the  -definition-  of  -the  cctsa^-area^  in- 
the -^OREatabaseType--  ‘.record  -in^.QipnLiPAS.  ***************)- 
connentareatype  =  string; 


batdiqueueentryptr  =  ^batchqueueentry; 

batchqufiueentry  =  record  ParameterStuff:  SavedParamsRecord; 

OcoinentArea:  CcraoentAreaType; 

filename;  string; 

next:  batdiqueueentryptr; 

end; 

List^tr  =  ^List; 

List  =  Record 

EName  :  string[12]; 

Next  :  Listptr; 
end; 


cellgridptr  *=  ^cellgrid; 

CellPtr  *  ^Cell; 

CellShowProcedure  =  procedure  (selfptr  ;  CellPtr) ; 

CellGrldCancelProc  »  procedure  (sel^jtr  :  CellPtr) ; 

ActionProcedure  =  procedure; 

CellActdonProcedure  »  procedure  (selfptr  :  CellPtr;  CellNumber;  integer) ; 

PickMenuActionArray  *  array[l..Max^ftJIItoerPickEuttons]  of  ActionProcedure; 
PickMenuNameArxay  »  array [1.  .MaxNtadserPickButtons]  of  shortstring; 
PiddtenuHOtkeyArray  *  array[l.  .MaXthanberPicdcButtc^  of  char; 
namearray  =  array(l.  .MawNumberMirtrialExcdrsiveButt^  of  shortstring; 


iD^  *  object  (control) 

CenterX, 

CenterY  :  integer; 

ZocraFactor  ;  real; 

M^BacloSroundColor, 

MapCXrtlineColor  ;  word; 

constructor  Init(InitX,  InitY,  InitWidth,  InitHeight  ;  integer; 

InitBackgroundColor,  InitMapOuclineColor:  word) ; 
procedure  Shew;  virtual; 
procedure  HiLite(Xpos,^5»s;word) ;  virtual; 
end; 


{  window  and  menu  type  declarations  ) 
menu  =  object  (window)  {  menu  type  windows  ) 
procedure  Cancel;  virtual; 
end; 


linkedbutton  =  object  (textbutton) 
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AddatlE$c5:pr?3ceduTOr-  ■ 

apnstiructor^Init  (IrutXrlnitY ,  InitWiatHVinitHeight , 

InitColor ,  InitHilitecolor , 

InitNameColor ,  InitHil  it^feuneColor:  Integer; 

InitNamB:shortstrii>g;InitAc1iLonEroc:ActionPnxaaare;InitlIotKiey;char) ; 
function  acticn(XX,YY;wDrd)  :boolean;  virtual; 
end; 


linkedbutton3D  object (textbutton3d) 

ActicnProc:prooeduxe; 

censtnictor  Init{InitX,InitY,InitWidth,InitHeic^it, 

InitColor « InitHilitecolcsr, 

InitNameOclor ,  InitHiliteNameColor:  Integer;' 

InitNaine:shartstring;InitActianProc:ActionProcedure;InitHotKey:char) ; 
function-’action(XX,YY;word).:boolean;  virtual; 
end; 


MutExcl;3siv^  *  cbject(Control) 

Picked: integer; 

ControlLabel:  shojrtstring; 

NunberBuctons :  integer; 

Orientation  :  boolean; 
xoffsetjvoffset  ;  integer; 

ButtonArray:  Array[l.  .MaxNuntoerMitualDotlusiveButt^  OF  StatusEutton; 
constructor  Init(InitX,InitY,InitWidth,InitHeight, 

InitColor ,  InitHilitecolor ,  InitSelectadColor , 

InitNameColor  /  InitHiliteNameCblor,  InitSelectsdNaroeColor :  Integer; 
InitCcntrolIatoel;shortstring;InitNunberfiuttons,  IiiitButtonSelected:  integer; 
ButtonNaineList:nanearray;InitOrientation:tcolean) ; 
procedure  HiLite(J^xs,Ypos;word) ;  virtual; 
procedure  Show;  virtual; 
procedure  c2iangeXY(J^xs,Ypos:word) ;  virtual; 
function  Action(Xpos,Ypos;word)  :boolean;  virtual; 
end; 


OrDffSlideControl  »  object  (Control) 

On ,  Of f :  StatusButton ; 

Sid:  HorizcntalSlideBar ; 

constructor  Init (InitX, InitY,  InitColor,  InitailiteColor ,  InitSelectedColor , 

InitCcntrolOolor,  LnitKilitaCcntrolColor,  IrutSelactsiControlColor;  word; 
Ini.tIoLim,  InitHiLim,  Initlnc;longint; 

InitAccel :  integer ;  InitName,  InitCnits :  shortstring) ; 
procedure  HiLite Qipcs ,  Ypcs;wcrd) ;  virtual; 
procedure  Show;  virtual; 

function  Action(]Gxs,  Ypcs: word) ; boolean;  virtual; 
end; 
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functicjn  Action (^^xas'jYpos:^^!)  rJxolean;  virtual-; 
end; 


pickmenu  *  object  (menu) 

buttcnarray;  array[l.,Max^fiJBItoerPickButtons]  of  linkedbuttonSD; 
NunberButtons:  integer; 

constoctor  Init(3{pos,Ypos;vra:d;InitNumberButtons;integer; 

InitNaneList :  PicJcMenuNameArray ;  InitActions :  PickMenuActionArxay ; 
InitHotkBys:PicilcMenuHCt^  ; 
procedure  Shew;  virtual; 
procedure  HiLite(5!pos,Ypos:word) ;  virtual; 
function  Action(34x3s,Ypos;word)  :b»lean;virtu2il; 
function  KeyAction(34x3s,Ypos:word;Kiey: integer)  iboolean;  virtual; 
end; 


emenuptr  =  ''emenu; 
emenu  «  object  (menu) 

{  flags  indicate  what  to  do  in  process  ) 
reconpite,  rethreshold:  boolean; 

QRFile,Wei^Ttsfile:  string; 

Psa,SNR,ShortIongRatio,XArgle,HiaseDev,a»P;HorizontalSlideBar; 

EM,  (PsaCalculat^fode,  )StatianBeliabilityModel, 

PsaR^xartMode,  J^:MitExclusiveN; 

StationPewer;  ARRAY[1.  .8]  OF  OnpffSlideControl; 

(  R«A,PwrB,PwrC,PwrO,PwrE,PwrF,PwrG,PwrH;OnOffSlideControl;  ) 
ManthSelectors:  ARRAY[1..123  OF  SelectButton; 

HourSelectors:  AERAY[1.,24]  OF  SelectButton ; 

Reliability ,  Weights ,  Batch,  Process:  linkedbuttonSd; 

constructor  Init(J^x»,Ypos;\'rord;IUink,Wlink,Blink,Plink;ActionProcedure) ; 
procedure  Show;  virtual; 
procedure  HiLite(}$os,Ypos;word) ;  virtual; 
function  Action (J$)os,Ypos: word)  :boolean;virtual; 
function  KeyAction(J$x3s,Ypos:word;Key: integer)  :boolean;  virtual; 
procedure  Cancel;  virtual; 
end; 


dmsnuptr  =  ^dmenu; 

dmenu-g  object(meru) 

lothresh,hithresh:Hori2ontalSlideBar; 

Dif fMode :  MutExclx:isiv€N ; 

Accept;  lirJ<£dbucton3d; 

consmictor  Irdt(:2^xs,Ypcs:word;Alink:ActionPrccedure)  ; 
procedure  Show;  virtual; 
procedure  Hi,I.ite(]&xas,Ypcs:word) ;  virtual; 
function  Action  Qipcs ,  Ypos :  w'ord) ;  boolean ; virtual ; 
function  ifeyActicn(^ix::s,Ypcs:wDrd;Key:incager)  rbcolean;  virtual; 
end; 
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(  10  degree  cell  definition  object  } 


cpII  =  object  (control) 
Bitlmg/ALOcBitlmg 
Weightjor_Coverage 
Pac 

AboveColor,belcwcolor 

CellNunber 

ActionProc 

Showiroc 

region,  Abovefihreshold 


^byte; 

byte; 

single; 

integer; 

integer; 

CellActianProoedure ; 

CellShowProcedure; 

boolean; 


BorderOolor, 

BorderHiliteColor  :  word; 

lat,lon  ;  integer; 

Constructor  Init(InitX,InitY,InitWidth,InitHeight,InitIat,InitLon, 
InitCellNurnber:  integer; 

InitAboveColor ,  InitBelowColor ,  InitSorderColor , 
InitBorderHiliteColor:  word; 

InitActicnProc  :  CellActionProcedure; 
InitShowPtoc  ;  CellShowProcedure); 


Procedure 

Show; 

virtual; 

Procedure 

Shc^^ion; 

Procedure 

HidePegion; 

Procedure 

Hilite  ( J^X3S ,  Ypos : 

word) ; 

virtual; 

Procedure 

UnHilite; 

Function 

Action  (3<t)os ,  Ypes: 

word)  :  boolean; 

virtual; 

Function 

IsAbovelhreshold 

;  boolean; 

virtual; 

Procedure 

Cancel; 

virtual; 

end; 


CellGrid  *  cbject( control) 

CancsrX, 

CenterY  ;  integer; 

ZocnFactor  :  real; 

Cellindex  :  inceger; 

CancelProcedure  :  CellGridCancelProc ; 

CellArray;  ARRAYCl.  .444]  OF  cell; 

constructor  Init(InitX,  InitY,  Initwidth,  InitHeight  :  integer; 
InitActicnProc  :  Cel  I  ActicnPrccedure ; 
InitShowProc  ;  CellShwProcsdure; 
InitCancelProc  :  CellGridCancelProc; 
initabovecolor,  inittelcwcolor ,  initborderoolcr , 
initiiilitecolor:  integer)  ; 

Procedure  Shew;  virtual; 

Procedure  Hili-!S(3&x:;s,Ypos;wDrd) ;  virtual; 
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Function  .Actian(}{i5os>Ypos:word)‘:boolean;  virtual-; 
procedure  Cancel;  virtual; 

end; 

CoverageGridPtr  «  ^OoverageGrid; 

CoverageGrid  =  object  (oellgrid) 

Procedure  Shew;  virtual; 

end; 


Coordinate  *  record 

x,y  :  integer; 
end; 


Wei(^itsQridPtr  »  '^Wei^tsOrid; 

Wei^tsGrid  =  object  (cellgrid) 

HasBeenChanged,pic}dj:gweights,S€lectingByGnxp:  boolean; 
FirstCoordflastCoord  ;  Coordinate; 

^rtr:  emenuptr; 
weightsfile;  string; 

Procedure  Show;  virtual 
exri; 


Dif  f  Cel IPopWindcw  =*  object  (menu) 
textcolor, 

selectedcolor  :  word; 
HilitedCellPtr  :  ''Cell; 


constructor  Init(InitX,InitY,Initwidth,InitHeight  :  integer; 

InitColor,  InitBorderColor ,  InitTextColor , 
InitHiliteColor,InitSelectedColor:  word) ; 
procedure  Show;  virtual; 

procedure  Cancel;  virtual; 

end; 


Cel  IPopWindcw  =  object  (menu) 


subcells 

:  Array[1..12,  1 

Pac 

;  real; 

Vfeigit 

;  integer; 

CellNum 

:  integer; 

eper 

:  emenirotr; 

month, 

hour, 

xoffset, 

yoffset, 

callwidth, 

cellheiy,.t 

:  integer; 
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textcdl6r> 

selectedcx>lbr  •  :  word; 
HilitedCellPtx  :  ^Cell; 


constiuctor  Init(InitX,  InitY,  mitwidth,  InitHei^t:  Integer; 

InitOolor ,  InitBorderColor/ InitTextColor , 
InitHiliteOolor,InitSelectedColor:  word; 
InitActicmPiroc:  CellActionProcedure ; 
InitShowProc:CellShcwPnx»iure; 


proc&iure 

procedure 

function 

procedure 

end; 


InitOellColor:v»rd;Ijiiteptr:emenipta:) ; 
Show;  virtual; 

HiIiite(Xpcs,Ypos:word) ;  virtxal; 

Action(}{pos,ypos:word)  :  boolean;  virtual; 


cancel; 


virtual; 


SubCellPqsWindcw  =  object  (menu) 

Pat  :  reed; 

xoffset,yoffset  :  integer; 

Stations  :  MutExclxisiveN; 

MDCJ  :  linkedbutton; 

BottcnMenuShown, 

MDCJ_shown  :  boolean; 

BottcmMenu  :  window; 

TextColor, 

SelectedColor  :  word; 
HilitedCellPtr:  ^cell; 


constructor  Init(InitX,  InitY,  IniWidth,  InitHeight;  Integer; 

InitColor ,  InitBorderColor ,  InitTextColor , 
IiutSelectedColor:  word; 


procedure 

procedure 

function 

function 

procedure 

procedure 

end; 


InitActionProc;ActionErocedure) ; 

FillBottanDfWindcw; 

Shew;  virtual; 

Action  C^pcs ,  Ypos ;  word) ;  boolean ;  virtual  ; 
K^Acticn(3$x3s,Ypcs;word;Jcey:intager) :  boolean;  virtual; 
Hilite  {ypos ,  Ypos ; word) ;  virtual  ; 

cancel;  virtual; 


lineniEtr  =  ^Imenu; 

Imenu  =  cbject{iDenu) 

Dlist  :  listptr; 

listrosition, 

listlength  :  integer; 

CEEADIJrPAIH, 
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EString  :  string; 

SelectedFile  ;  string; 

Direc±oryMaskButton  :  BditButton; 

DirectoryList  ;  MutExclusiveN; 

VBar  :  VerticalSlideBar; 

ViewButton, 

LoadButton  :  linkedbuttcsi30; 

mc,atoc  ;  word; 

ccaistructor  Init Ypos:vA3rd;InitMenuColor, InitMenuBorderColoriword; 
Vlink,  Ilink;  ActicjnPnxsdure ; 
InitKith,InitEString:string) ; 


procedure 

Shew; 

virtual; 

procedure 

HiIiite(Xpos,Ypos:word) ; 

virtual; 

function 

Action  (XpoB,  Ypos :  word) 

;  .toolean; 

virtual; 

function 

ReyAction  (Xpos ,  Ypcs:wDrd;Key:  integer) 

:  boolean; 

virtual; 

procedure 

Cancel; 

virtual; 

procedure 

DisposeOldDirectoryList  ; 

procedure 

DisplayDirectoryList ; 

procedure 

GetNewDirectoryLdst ; 

end; 

Ibarptr  »  -'Icwerstatusbar; 
lowarstatusbar  =•  c±)ject(borderedarea) 
artr:  emenuptr; 

MinPsa,MeaiiPsa,MaxPsa,PegMinPsa,RegMeaiTPsa,RegMaxPsa:single; 

Archivefile, 

Weightsfile, 

QRfile  :  string; 

constructor  Init (InitX,  InitY,  InitWidth,  InitHeight,  InitColor ,  InitBorterColor : word; 

Init^]ftr:eineni:ptr) ; 
procedure  Shew;  virtual; 
end; 

sidestatusbar  -  djject(borderedarea) 
eptr;  emenuptr; 

constructor  Init  (InitX,  InitY,  InitWidth,  InitHeight,  InitColor,  InitBorderColorrword; 

Init^Ttriemenimjtr) ; 
procedure  Shew;  virtual; 
end; 

stubcbject  *  cbjeet(menu) 
constructor  Init; 
procedure  Show;  virrual; 
end; 

>femcArea  =  cto  j  ect  (horderedarea ) 

Font  :  word; 

TexoLineHeight , 

EorderSize, 
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NumLin^:*.-  :  intag^*;- 

HiliteColor, 

TextOolor, 

HilitedtextColor  :  word; 
Display_String, 

MesndTejct  :  MestcOtextiype; 


constnjctor 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

function 


Init  (InitX,  InitY,  InitFont,  InitColor ,  InitHiLiteColor , 
InitTextOolor ,  InitHiliteltextColor , 
IiutBorderOolorrword) ; 

GetNewText(Text;QxnmentAreaT^  ; 

AssignChangecCrext(V2u:  TexttConnentAreaOype)'; 

HideGlieCursor  (LineNum:  integer) ; 

ShowTheOirsor (LineNum,  CursorPosition:  integer)  ; 

Show;  virtual; 

Hilite  (3^X36 ,  ^ipos ;  word) ;  virtual ; 

DisplayText  (NewText  iMencOtextiype  ; 

LineNum,  CuirsorPosition:  integer) ; 

Action (X^3CS,Ypos  :  word)  :  boolean;  virtual; 


end; 


SavdSenuPtr  »  '^SaveMenu; 
Sav^fenu  «  object  (menu) 
TextLabel, 

Title  :  string; 

TextColor  :  word; 

xoffset, 


yoffset 

MemoBox 

SaveButton 

FileButton 

constructor 


procedure 

procedure 

function 

function 

procedure 

end; 


:  integFx; 

:  MemoArea; 


:  linkedbuttorOD; 

;  EditButton; 

Init(InitX,  InitY,  InitWidth,  InitHeight:  Integer; 
InitColor ,  InitHiliteColor ,  InitMemoColor , 
InitMemcHiliteColor,  InitBorderColor , 
InitTextColor,InitHiliteTextColor, InitFont:  word; 


Slink:  ActionProcedure;  InitFileString:  string) 

Shew; 

HiLite (J^jos ,  Ypos:word) ; 

Action (34x»,Ypos: word)  :  boolean; 

KieyAction(}4xs,Ypos:word;  key:integer) :  boolean; 
Cancel; 


virtual; 

virtual; 

virtual; 

virtual; 

virtual; 


Helidfenu  =  object  (menu) 


Textiabel, 

Title 

HelpFileNaroe 

TextQslor 


:  string; 

:  shortstring 
:  word; 
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boxDffset,- 

XDffset, 

yoffset  :  integer; 

Nextfiutton, 

PrevButtan  :  liii3cedfcctton3D; 

GcdtoButton  :  EditButton; 

constructor  Init(InitX,  InitY,  Initwidth,  InitHeight:  Integer; 


InitOolor ,  InitHiliteOolor ,  InitBorderColor , 
Iiut3textOolar,InitHiliteJrextColor,IiiitFont:  word; 
Nlink,Plink;Ac±ica^>rcx»dure) ; 


procedure 

Show; 

virtual; 

procedure 

HiLite(Xpos,Ypos:word) ; 

virtual; 

function 

IsHelpFile (filename  :  string):  boolean; 

function 

Action(3qpos,Ypos:word)  : 

boolean; 

virtual; 

function 

KeyAction(34xs,Ypos:word;  key:integer) : 

boolean; 

virtual; 

procedure 

ClearWindcw; 

procedure 

ShowText; 

procedure 

Cancel; 

virtual; 

end; 


{  the  message  box  object  takes  an  irpit  string  of  max  length  250 
and  displays  it  in  a  window  } 


messageboxobject  ®  object  (window) 

procedure  displaymessage(Xpcs,Ypos,nlines,nchars,backcolor,textcolor:  integer; 

message:  string) ; 

procedure  hidemessage; 

procedure  ohangeattr(XX,YY,WW,HH,BK,TX:  integer) ; 
procedure  redisplaymessage(nlines,nchars: integer;  message:  string) ; 
end; 


procedure  SaveBditParams(a3tr;emeniptr;saved:savedparansrscort:^;tr) ; 
procedure  RestoreEditParems(eptr;emeni:5to:;  saved  :saveqparamsrecor±±r) ; 
Procedure  ShcwCurrerrtPickChoice; 
procedure  messagewait; 

function  FileName  (context  ;  shortstring)  :  shortstring; 


Var 


(***********  the  definition  for  the  QR  path  variable  is  moved  to  QRutil. PAS 
QRPA2H, 

jr****!******) 
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laessagdxoc:-^  isessag^xKicib^'ectT^ 

batchgLie2e,tcpo£batdiqueue:  tetcfaqueueentryptry 

Basescreen ,  basescreen2 :  ■^borderedarea ; 
stubwindow:  -'stubobject ; 

h,  g,  f ,  s,  o,  r ,  dif fereix:e,  dif f ere»»2 ,  a:,  dr :  ^linkedbutton3D  ? 


ECGde^, 

BIGbi^2; 

lEETmap; 

RlSntas^)  : 

BIGCellGrid, 

IZFTCellGrid, 

RTCSnCellGrid, 
diffcellgrid;  CellGridPtx; 

Weic^itCellGrid  :  Wei^tsGridPtr; 

CcjverageCellGrld:  CoverageSrldPtr; 

Filemem,  LeftFileiiem,Ri^tFilemenii,  cptionsrnenu:  ''pickmenu; 
EditmenU/AuxEditaaenu:  ^emenu; 

Diffmenu:  dmenupcr; 

ListJlenu, 

Ri<^tListit>enu, 

KeliabilityListMenu, 

AuxReliabilityListMenu, 

Wei^tsListMenu  ;  ^linenu; 

Lsftsplit :  ''borderedarea ; 

Ri^tsplit:  ^borderedarea; 

If ,  rf : ''linlcsdbuttorOD ; 

leftlcwerstatus ,  ri(^tlcvierstatus:  ^Icwerstarusbar ; 
leftsidestatus ,  rightsidescatus :  -'sidestatusbar ; 

lef tejgand,  rightexpand;  ''linkedbuttOTSD; 

DiffCallPc^^  ;  ^DiffCellPcpWlrncw; 

CellPopCto  ;  ^CaliPcr^indcw; 

SubCallPcpUp  :  ''SubCellPcpWindcw; 

SaveMenuWirdcw ,  auxsavensnuwindcw ,  WeightsSaveMejiuWindcw , 
qtieuesaveineriaiwiix:w,auxqueuesaveirenuvdixiow  :  ^SaveMenu; 
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HelpifenuWindcw'  :  ^HelpMenu; 
(7nT:boolean; 
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UNIT^"'ErTO.cg,:-. 


*  ■  '  * 

*  EEXXSAM  NAME'  -  Cm^  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME  -  ERRIDG  * 

*  * 


*  * 

*  This  .program  vras  prepared  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  ttrive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  catpatible  * 

*  under  MS-DOS  3.3  or  hicfier  vdth  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  catpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  p^ormed  under  contract  number  * 

*  Dr0323-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Cttega  Navigation  System  Center  (OJSCEN) ,  Alexandria,  VA.  * 

*  * 


************************************************************************ 


*  * 

*  RJRPCSE  * 

*  General  purpose  error  Icx^ing  routine.  Error  messages  * 

*  are  written  to  the  file  ''ERRDR.IOG*'  and  a  warning  sound  * 

*  is  generated.  * 

*  * 


************************************************************************* j 


I^TTERFACE 
Uses  Crt; 

PKX2IURE  Icg_Error (Message:  String) ; 


IMPLEMENIATiaJ 

VAR 

f:  text; 

PRCCEEXJRE  Icg_Errcr (Message:  String) ; 

{ 

*  X 

*  PDRPOSE 
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*  Write' a  message  to  the  ERRCR'.-LX-  file  and*  alert  the  ijser  * 

*  that  a  message  has  been  recorded:  The  ERRCR'.LDG  file  is  * 

*  re-written  each  time  PACE  is  run.  * 

*************************************************************************** 

} 

VAR 

i,  freq  ;  Integer; 

BEGIN 

Assign(f,  'Error.log');  Iipp&nd{f); 

Writeln(f ,  Message) ; 

Close (f) ; 

{  Make  seme  phaser  sounds  } 

Nosound; 

FOR  i  :=  1  TD  3  DO 
BEGIN 

Freq  ;=  5000; 

repeat 

Sound  (Freq) ; 

Freq  :=  Round (Freq*0. 995) 

UNTIL  Freq  <=  125; 

NoSound 

END 

END; 


BEGIN 

{  Create  a  new  and  errpty  error  log  file  } 
Assign(f,  'Error.log') ;  Rewrite (f) ; 
aose(f) ; 

END. 
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* 

* 

* 

* 

* 

* 

* 

* 


ERCXaRAM  NAME  **  Onega  Performance  Assessment 

and 

Coverage  Evaluation 
(PACE) 

Workstatirai 

UNIT  NAME  -  Part  of  the  PACEOBJS  Uhit 


* 

* 

* 

* 

* 

* 

* 

* 

* 


A*********************************************************************** 


★  * 

*  Hiis  program  was  prepared  by  * 

*  * 

*  The  Analytic  Science  Ocarporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  develcped  to  run  on  a  UM  PC/AT  or  ccnpatible  * 

*  under  MS-DC6  3.3  or  higher  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  cotpatible  graphics  adapter  and  color  * 

*  monitor.  Hiis  work  was  performed  under  contract  number  * 

*  ETCG23-89-C-20008,  Task  Order  90-0001,  Task  No,  5834,  for  * 

*  the  CSnega  Navigation  System  Carter  (CNSCEN) ,  Alexandria,  VA.  * 

*  * 

*******itli*itiiiiit**irk****it**iiit****ititii*-k****iiitit**it**ifk***it***it******-k**it**ifk 
*  * 

*  PURPOSE  * 

*  Collection  of  object  methods  and  utility  routines  for  the  * 

*  PAGE  context  sensetive  help  subsystem.  * 

*  * 

*  * 


**********************************»r*r*****ifc******************************  J 


procedure  GerjerateContextHelpList(var  f  ;  text) ; 

{ 

***»************')r*****l>r*'*t*ir*i«r*'**********Tir*'*****'******'jt***xT»'*'*>r********w* 


* 

* 

* 

* 

* 

* 

* 


* 

PURPOSE  * 

Read  the  list  of  help  sections  and  associated  contexts  that* 
frcrn  the  help  information  file.  Store  the  section  names  and* 
associated  contexts  in  a  list  so  that  we  can  access  the  * 
arproprlats  help  section  vhen  a  particular  context  is  * 

active.  * 


} 


var 

Endpcr,terp  ;  CHIPtr; 
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begin 

ContextHelpIiist  :=  nil; 

While  not  EOF(f)  do 
begin 
new(teiip) ; 

if  (tanp  =  nil)  then 
begin 

Log_Error('Not  enou^  memory  to  Generate  Context  Help  List') ; 
end; 

tenp^.Next  :=  nil; 

readln(f,teiip^.OontextStr) ; 
readln  ( f ,  tenp’^ .  filename) ; 

if  ContextHelpList  =  nil  then  (*  at  beginning  *) 

begin 

ContextHelpList  ;=  tenp; 

EndPtr  :=  ContextHelpLisr:; 
end 
else 

begin  (*  otherwise,  add  at  end  *) 

Enc^3t!r  .Next  tenp; 

Enc^Jtr  :=  Endptr^.next; 
end; 
end; 
end; 


(*  otherwise,  add  at  end  *) 


procedure  GenerateHelpFilesList(var  f  :  text) ; 

{ 

************************************************************************* 
*  * 

*  KIRPOSE  * 

*  Generate  a  list  of  help  files  that  correspond  to  the  * 

*  various  help  sections  that  are  available  in  * 

*  PACE  help  subsystem.  Giedc  for  the  existence  of  each  help  * 

*  file  as  it  is  inserted  into  the  list.  * 

Tk*********************************************************************** 


var 

FoundFile  :  boolean; 
hf  :  text; 

En±3tr,te!ip  :  HFLPtr; 


begin 

KelpFilesList  :=  nil; 
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dck-. 

begin 

new(ten5))  ; 

if  (taip  =  nil)  then 
begin 

Log_Error ( 'Net  encugh  memory  to  Generate  Help  Files  List') ; 
end,^ 

tenp^.Next  :*  nil; 
temp^.Prev  :=  tenp; 
readln  ( f ,  teBf>^ .  filename) ; 

(★  test  to  see  if  files  exist  *) 

Assign(hf ,HelpPath +■  '\'  +  temp^.filensone  +-'.HIP')  ; 

{$!-) 

Reset  (hf)  ; 

{$!+} 

if  (IQResult  o  0)  then 
begin 

Iog_ErTor( 'Problem  opening  file:  '  +  HelpPath  +  '\'  +  tenp'' . filename  +  '.HLP'  )  ; 
FoundFile  :*  FAISE; 
end 
else 
begin 

FoundFile  :*  TRUE; 
close  (hf) ; 
end; 


if  FoundFile  then  (*  if  file  is  found,  then  add  to  our  list  *) 
begin 

if  HelpFiicsList  »  nil  then  (*  at  beginning  *) 

begin 

HelpFilesList  :=»  tenp; 

EndPtr  :»  HelpFilesList; 
tenp^.Prev  :*  nil; 
end 
else 

begin  (*  otherwise,  add  at  end  *) 

Enc^rtr'.Next  :=  tenp; 
tenp^.Prev  :=  Enc^Jtr; 

Endptr  ;=  Endptr'.next; 
end; 
end; 
end; 
end; 


procedure  Initial  it  eKelpSystem; 
{ 
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***★*****it^l^******1•t*****'★*^fc*  *************'*********■*  *^^*5lt*'**************** 


* 


* 


*  HIRK3SE  * 

*  Set  1?)  the  help  subsystem  by  checking  for  the  help  system  * 

*  information  file  and  creating  the  help  section  lists  * 


} 


var 

f  :  text; 
begin 

Assign (f,HelpPath  +  +  ContextFile) ; 

{$!-) 

Reset(f) ; 

{$!+} 

if  (lOResult  o  0)  then 
begin 

Icg_Error(  ^Problem  opening  file:  '  +  HelpPath  +  '\'  +  ContextFile) ; 
end 
ELSE 
begin 

GenerateContextHelpList(f) ; 

Close (f) ; 
end; 


Assign (f, HelpPath  +  *y  +  HelpFile) ; 

{$!-) 

Peset(f) ; 

{$!+} 

if  (lOResult  o  0)  then 
begin 

Iog_Error  ( *  Problem  opening  file:  '  +  HelpPath  +  '\'  +  HelpFile) ; 
end 
ELSE 
begin 

GenerataHelpFilesLisr(f) ; 

Close  (f)  ; 
end; 
end; 


functrion  FileNaroe  (context  :  shortstring)  :  shortstring; 

{ 

***********»'*  ***»*'******T#*'*'»f*iit***'»t'*'**'*»t»t*')lc'****x**»Tir******'**»:'******:«tw**i** 
*  * 

*  FJRPOSE  * 

*  Associates  a  help  secticn/help  file  name  for  a  given  * 

*  COTtext.  Provides  the  ccntaxc-sensetive  part  of  the  help  * 

*  subsystem.  * 
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} 

vcur 

poiirter  :  CHIPtx; 
begin 

pointer  :=  ContextHelpList ; 

While  (pointer  o  nil)  AND  (NCfT  (contesct  -  pointer^. ContextStr))  do 
pointer  :*=  pointer', next; 

if  (context  *  pointer'. ContextStr)  then- 
FileNarae  :® ^pointer'.filenaone 
else 

FileName  :* 

end; 


Constructor  HelpMenu.Init(InitX,  InitY,  InitWidth,  InitHeight:  Integer; 

InitColor ,  InitHiliteColor ,  InitBorderColor , 
InitTextColor ,  InitHiliteTextColor ,  InitFont :  word ; 
Nlink,Plink:ActionProcedure) ; 

{ 

*★♦★*****************★***■***■*★»***★********★*•****★*******★★*★■***★******* 


* 

PURPOSE  * 

Object  initialization  code  to  set  up  the  context  sensitive  * 
help  subsystem  interface  screens.  * 

★*»riir***************;*t**************************************************** 


* 

★ 

★ 

* 


const 

be 

» 

20; 

(*  space  between  buttons  *) 

bw 

60; 

(*  button  width  *) 

bh 

=: 

16; 

(*  button  height  *) 

ew 

s 

160; 

r  (*  edit  button  width  *) 

eh 

15; 

(*  edit  button  height  *) 

begin 

TextColor 

InitTextColor; 

Title 

•  ^ 

"PACE  Help  Menu^ ; 

TextLabel  :=  'Secuicn  Number; ' ; 

bcKoffset  ;=  20; 

>®ffset  ;=  20; 

yoffset  :=  10; 

menu  ,  Init  (InitX,  InitY,  InitWidth,  InitHeight,  LnLtColcr , 

InitBorderColor,2,WindcwShadcwWidth) ; 
NextSitton.  Init  (InLtX-t-«3ff set ,  InitY+InitHeight-yof  fset~bh, 
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bw,ih,white,black>black,whiteii'Next'  ,NIiink',  'N') ; 

ErevButxoni  Init  (InitX+bi««-xof f set-fbs ,  InitY+InitHei^t-yof f set-rjii> 
bw,bh,«hite,blac3c,black,white,  'Prev' ,PLink,  'P') ; 

GcatoButton.  Init  (InitX+InitWidth-xof f set-ew, 
InitY+InitHei^t-yoffset-^, 
ew, eh, white, black, black, white/', 0,4, 19, TTOE) ; 


InitializeffelpSystan; 


end; 


procedure  HelpMenu.Shcw; 
{ 


it .  it 

*  FURPOSE  * 

*  Display  a  page  Of  the  context  sensitive  help  and  the  * 

*  additional  help  controls.  * 


A************-*********************************************************** 

} 


var 

f  ;  text; 

XX, yy;  integer; 

OontaxtName  ;  shortstring; 
i  :  integer; 
helptext  :  stringCSO]; 


begin 

Get_CursorXY  (xx ,  yy ) ; 

Hide__Cursor; 
window. Show; 
setcolor(TextColor) ; 

rectangle  {X+boxof  fset ,  Y+boxoffset ,  X-Width-boxof  fset ,  Y+Height~NextButton.Keight~yof  f  set-  (bo 
rectangle  (X+boxof  fset+2 ,  Y+boxof  f  set+2 ,  X+Width-bcxoff  set-2 ,  Y+Height-NextButton .  Heic^it-yof  f  s 
settaxcjustify(centertaxt,tcctaxt) ; 
outtextxy(X+ (Width  DIV  2)  ,Y+(yoffset  DIV  2)-r2, Title)  ; 

settextjustify(righttext,centertext) ; 

cuttext^(GcabButton.X-5,GcToButton.Y+(GcToButbon.Height  DIV  2)+l,TextIabel) ; 

NextButton.  Shew; 

FrevButton.  Shew; 

ShowText; 

GOToButton .  Show ; 

Shcw_Curscr  (xx ,  yy ) ; 
end; 


File  Name:  HELEMENU.PAS 


■procedure  HelFMem.HiLite(3^x3s,Ypos:word)  ; 

{ 


*  * 

*  EORPCSE  * 

*  Method  to  hic^ic^it  the  help  interface  controls.  * 

*  * 


************************************************************************* 

) 

begin 

NextButbcn.Hilite(3^»s/Ypos) ; 

PrevButton.Hilite(X^,Ypos)  ; 

GcatoButtcin.Hilite(:<pos,Ypos)  ; 
end; 


function  HelpMem.IsHelpFile(filena£De: string) :  boolean; 

{ 

************************************************************************* 


*  * 

*  KIRPOSE  * 

*  Checks  for  the  existance  of  help  for  a  user  selected  * 

*  help  subsystem  section.  * 


**************************************************************************** 

} 

var 

i  :  integer; 
f  :  text; 

begin 

for  i  :=  1  to  length  (filename)  do 
if  filenaroeri]  ~  then 
filej^ame[i]  :=  'J', 

Assign  (f,HelpPath  +  +  filename  +  '.hlpO? 

{$1-} 

Reset(f) ; 

{$!+} 

if  (lOResult  =  0)  then 
begin 

HelpFileNaroe  :=  filename; 

IsHelpFile  ;=  TRUE; 
clcse(f) ; 
end 
else 

IsHelpFile  :=  FALSE; 
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end,*. 


function  HelpMenu.Actic3n(XJX3s, Ypos: word) :  boolean; 

{ 

************************************************************************** 
*  * 

*  HJRPOSE  * 

*  Method  for  performing  the  actions  associated  with  the  help  * 

*  subsystem  controls  to  page  through  the  help  information.  * 
************************************************************************* 

} 

var  . 

dummy  :  boolean; 
begin 

dummy  ;=  NextButton.Action()>pos,Ypos)  ; 
dummy  ;*  PrevButton.Action(Xpos,Ypos) ; 
if  GoroButton.Action(Xpos,Ypos)  then 
begin 

If  IsHelpFile(GoroButton.TextjString)  then 
begin 

ClearWindow; 

ShcwText; 

end 

else 

be^; 

end; 

end; 


function  Help^^nu.KeyAction(:^xK,Ypos;word;  keytinteger) ;  boolean; 

{ 

************************************************************************ 


*  * 

*  HJRPOSE  * 

*  Method  for  performing  the  hotkey  actions  associated  with  * 

*  the  help  subsystem  controls  to  page  through  the  help  * 

*  information.  * 


************************************************************************** 

} 


var 

dummy  :  boolean; 
begin 

KeyActicn  ;=  false; 

if  (NextButton. KeyActicn (}tx:s,Ypcs, key) )  OR 
(Prevaitton.  KeyActicn  (Sxs ,  Ypcs ,  l<ey) )  then 
FteyActicn  :=  true; 
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end;,. 

procedure  Helpifenu.ClearWindow; 

{ 

**************************************************************************** 


*  * 

*  HJRPOSE  * 

*  Cleans  up  the  help  window  so  that  the  next  page  of  help  * 

*  can  be  displayed.  * 


************************************************************************** 

) 

var 

XX, yy  :  integer; 
begin 

Get_CursorXir(xx,yy)  ; 

HidejCursor; 

setfillstyle(solidf ill, Color)  ; 

bar  (X+boxof  f  set+3 ,  Y+boxof f  sct+3 ,  X+Width-boxoff set-3 ,  Y+Height-NextButiOsn .  Height-yof  f  set-  (bo 
Show_Cursor(xx,yy) ; 
end; 


procedure  HelpMenu.ShcwText; 
{ 


★  ★ 

*  PUKFOSE  * 

*  Writes  the  actual  help  information  into  the  help  window.  * 

*  * 


**********  ★■*'***********'******'****i»*********************'**********'******* 

} 

const 

Xcextoffset  =  IS; 

Ytextoffset  =  10; 
maxnumlines  =  23; 


var 

i.  •  wcAUf 

XX, yy;  integer; 
i  :  integer; 
tenp  :  string; 
helptext  :  string[80]; 


begin 

Get_CursorXY(xx,yy) ; 

Hide_Cursor; 

Assign tf,KeipPath  -  '\'  -  HelpFileNaine  -  '.ML?'); 
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{SI-} 

Reset (f) ; 

{$!+} 

if  (lOResult  o  0)  then 

Ii3g[Jtarar( 'Problem  opening  file:  '  +  HelpPath  +  '\'  +  HelpFileName) 
else 
begin 

tenp  ;=  HelpFileName; 

for  i  :=  1  to  length(tenp)  do 

begin 

if  tenp[i]  =  then 
tenp[i]  := 

end; 

GoC[toButton.C2xange_String(teiip) ; 

Gc/ToButton.ReShow; 

(*  GoI'oButton.Displayrext(tenp) ;  *) 

i  ;*  0; 

settextjxastify(lefttext,toptext) ; 

setcolor(textcolor) ; 

settextstyle ( smallf ont , hori2dir ,  4 ) ; 

while  not  EDF(f)  and  (i  <  maxnumlines)  do 
begin 
inc(i) ; 

readln  ( f ,  helptext ) ; 

cwttextJQ^  (X-H»xof f set+Xtextof f set ,  Y+boxof fset+Ytextof f set*i ,  helptext) ; 
end; 

Close (f ) ; 
end; 

settextstyle(defaultfont,hori2dir,l) ; 

Shcw_Cursor(xx,yy)  ; 
end; 


procedure  HelpMenu. Cancel; 

{ 

*************yt********it*vtieit*it***********it***************it******ifxyt**itif»'x 


*  * 

*  H3HP0SE  * 

*  Method  for  removing  the  help  subsystem  window  from  the  * 

*  display.  * 


******************************************»***************^************* 

} 


begin 

Menu. Cancel; 
end; 
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*  FRDGRfiM  NAME  -  Ctnega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME  -  Part  of  the  CEUITTIL  Unit  * 

*  * 

*  * 

*  This  program  was  pn^aared  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  canpatible  * 

*  under  MS-DOS  3.3  or  higher  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccrpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DrCG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (CJISCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Utilities  to  load  the  PACE  10  degree  latitude  by  10  degree  * 

*  longitude  cell  definitions.  Variation  of  the  code  contained* 

*  in  the  loaddef.pas  program  file.  * 

*  * 


************************************************************************ j 


PROCEDURE  Ioad__Cell_Definiticn(  cellsize  :  Integer; 

^TAR  Call_Defn_List  :  Cell_defn_ptr; 

VAR  Numb  Cells  :  Integer) ; 

{ 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  load  the  cell  grid  definitions  into  a  memory  based  linked-  * 

list.  * 

************************************************************:«****5(**9f*** 

} 


load  cell  definition  for  indicared  cellsize  into  memory  as  a 

list  attached  to  the  pointer  Csll_Defn_IisT;.  Cellsize  is  the  basic  size 

(size  at  the  equator)  in  degrees  (e.g. ,  5,  10) . 


{ 


File  Name:  LDAD  DEF.PAS 


NuntMCells  .is--sefc  ;to  the.,'Twn3ber  of  cells  read  in-. 

Hie  fonnat  of  the  file  name  is;  GRID_nn.DEF 
Where  nn  is  the  basic  cell  size  in  degrees 

Ver  0  05/06/88  KMtencii 

Ver  1  05/23/90  BMftustvold  for  use  in  PACE  code 


VAR 

Cdefnfname  ;  string[40]; 

LastjCell, 

Tenp_cell  :  Cell_defn_Ptr; 

TenpjCell__Defn  ;  Cell_defn; 

fCdefn  :  file  of  Cell_Defn; 

i  ;  Integer; 

BEXHN 

{  figure  out  the  name  of  the  file  to  use  } 

0iefnfnaiie:*'(3?ID_'+DIGITS[Cellsi2e  div  10]+DIGITS[Cellsi2e  mod  10]+'.CEF'; 

{  Read  in  and  store  the  cell  definition  file  } 

Assign (fCdefn,  Cdefnfname) ;  Reset(fCdefn) ; 

Read(fCdefn,  Tenpjcelljdefn) ; 

New(  Cell_Defn_List  ) ; 

Cell_Defn_List^ . latl  ;»  Tenpjoel  1, jiefn. latl ; 

Cell_Defn__Ldst''.lat2  :=  Tenp_cellj3efn.lat2; 

Cell_Defn_List''.lonl  :*  Tenpjoel  I  jiefn.  lonl; 

Cell_Defn_List''.lon2  :=  Tenpjcell_de£n.lon2; 

Cell_Defn_List''. range  :*  0; 

Cell_De£n  List^  .bearing  ;=  0; 

(* 

Cell_Defn_List'^ . range  ;=  Tenpjcelljdefn.xlate [Station]  .range; 

Cell__Defn__List^  .bearing  ;=  Teiipjcelljiefn.xlate[Station]  .bearing; 

*) 

Last_Cell  :=  Celi_Defn_List; 

Nun^jCells  :=  1; 
wHni  Ncrr  BOF(fcaefn)  do  bexien 
Inc(Nunib_Cells) ; 

New(  TenpjCeLl  ) ; 

Read(fCdefn,  Te.Tp_cell_defn) ;  {  get  a  new  definition  and  store  away  } 

Tenp^CeH'^.latl  :=  Tencjcelljisfc.latl; 

Teiic)_Ce]J.^.lat2  :=  Tenpjoell jiefn.  Ia'c2 ; 

Te3Tp_Cell''.lonl  ;=  Tenp_cell_defn.  lonl ; 

TenEMCell''.lon2  :=  Tenp_cell_defn.lon2; 

Teiro_Cell''.  range  ;=  0; 

Tenp_Cell'^  .bearing  ;=  0; 

(* 

TenrjCell''. range  ;=  Tencjcslljiefn.xlatarstation]  .range; 


{  cell  definition  list  ) 

{  for  reading  in  the  definition  } 
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Tei5>^G^^.bea2?ir^ss:='<'®^^c^£d^^xlateCSt%ibn^i.be^^g|f 

Last_cell^.next  ;=  Tenpjoell;  {  link  new  one  into  the  list  } 
lastjoell  :=  Tenpjoell; 
llID; 

Last joell^. next  :=  nil;  {  mark  the  last  link  as  the  end  } 

Close  (fCdefn) ; 


^*****************************************************************************j 


{print  the  list  to  the  sareen  to  see  if  it's  in  memory  OK  ) 
TenpjCell  ;*  OeH_Defn_List; 
i  :*  0; 


REPEAT 
Inc(i) ; 

WITH  Ten?jCeU*  DO  BEGIN 

Write(I:4/  Lats  (Iatl/10)  :7:1,  (Iat2/10)  :7:1)  ; 

Write('  Lons  (lonl/10)  :7:1,  (Lon2/10)  :7:1)  ; 

Writeln('  i  Station  (Range/100) : 6; 2,  (Bearing/10) ;7;1) ; 

END; 

Tenp^Cell  ;=  TenpjCell^  .next; 

UNTIL  TenpjCell  =  nil; 

*) 

(*****************************************************************************) 


END; 
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|'jlt**x***********jt*************'***jlr*'*i<t*^lr*****'*3lt*********'********ifc*******'* 


*  * 

*  PE^OG^  NAME  ~  Cnega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  ★ 

*  ★ 

*  UNIT  NAME  -  Part  of  the  RBC0NV2  Program  * 

★  * 

*  * 

*  Biis  program  was  prepared  by  * 

*  * 

*  Ihe  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  ccjrpatible  * 

*  under  MS-DOS  3.3  or  hi<^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccnpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  Dr0323-89-C-20008,  Task*  Order  90-0001,  Task  No.  5834,  for  * 

*  the  omega  Navigation  Systan  Center  (C^BCEN) ,  Alexandria,  VA.  * 

*  * 

★★★★A******************************************************************* 
*  * 

*  fURPOSE  * 

*  Uiis  file  contains  utility  code  to  read  and  parse  the  * 

*  radial  format  signal  data  needed  by  the  range/bearing  to  * 

*  cell  format  database  conversion  program.  * 

•k  k 


************************************************************************ J 


PROCEDURE  Ioad_Range_Bearing_pata(  Station,  Month,  GMT, 

Freq:  Integer? 
VAR  RB_List:RB_Ptr)  ; 


************************************************************************** 


*  K3RP0SE  * 

*  Construct  the  appropriate  range/bearing  data  file  name,  * 

*  read  in  the  range/tearing  data  and  parse  the  input  data 

*  to  <±ftain  the  desired  signal  quantities.  * 


) 

{ 

$$$$$$$$$S$$$$$$S$$5$$$S$$$$SS$$$$5$$$$$$$$$$$$S$$$S$S$S$SS$S$$$S$S$SSS$S$SSS 
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LC1AD_RB.PAS 

Ver-l 

05/88V 

KATaxii- 

ver  2 

11/88 

DEPrahk' 

to’  process-ref drmatted-'Rah^/Bearihg^  file 

ver  3 

05/90 

KAITench 

added  RB  List  dip^xyal  and  hardwired  sta  C 
&  added  file  name  creation  frctn-  input  pararas 

ver  4 

10/90 

EMAustvcld 

Reraove  hardwired  station  C. 

Ihis  version  should  hardwire  the  month  of 
February. 

ver  5 

11/90 

BMAustvold 

Change  to  read  new  data  input  format 
Hardwired  NonStandardRadials 

new  format 

• 

• 

line 

1  -  e 

>  is 'header^'infomation 

STfi?^  MDN=Feb  GMr=01  S_PATH  BEAR-OOO  FREO»10.2 

DIS 

SPMl 

SPML  SPMS 

SPMS  LPWS 

AMP 

PHS  AMP 

PHS  AMP 

*10 

*10 

*10 

*10 

MM 

DB 

CEC  DB 

CEC  DB 

0 

999 

0  999 

0  -999 

lines  7  -  number  of  radials  contains  daia  in  the  columns 


cols  (01  -  04) 

cols  (05  -  09) 
cols  (10  -  14) 
cols  (15  -  19) 
cols  (20  -  24) 
cols  (25  -  29) 


-  distance  along  radial  in  tenths  of  a  MegaMeter 
(ie  1  “  0,1,  2  *  0.2,...  ) 

-  Short  Path  Mode  1  Anplitude  (dB) 

-  Short  Path  Mode  1  Phase  (cecs) 

-  Short  Path  Mode  Sum  Anplitude  (dB) 

-  Short  Path  Mode  Sura  Phase  (cecs) 

-  long  Path  Mode  Sum  Anplitxide  (cecs) 


$$$$$$$$$?$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 

) 


const 

NumberOfNcnStandardRadials  =  14; 


type 

NonStandardRadialiype  = 

array[l. .8,1. .NumberOfNcnStandardRadials]  of  integer; 
(*  8  scations  X  14  possible  Nonstarriarr^d-i  s  *) 

const 

NumberRecordsPerSadial  =  201;  (*  records  numbered  0  -  200  *) 

StepsizeAlongRadial  =  0.10;  (*  one  tenth  of  a  *) 

NonStandardPadials  :  .NTcnStandardRadialiype  = 

(*  A  *)((  45,  225,  105,  285,  115,  295,  000, 

000,  000,  000,  000,  000,  000,  000  ), 

(*  B  *)  (  17,  197,  156,  336,  165,  345,  175, 
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355, 

178, 

358, 

000, 

000> 

000, 

000- 

(* 

c 

*) 

( 

5, 

185, 

25, 

205, 

27, 

207, 

152, 

332, 

163, 

343, 

167, 

347, 

000, 

000 

), 

(* 

D 

*) 

( 

8, 

188, 

34, 

214, 

44, 

224, 

165, 

345, 

000, 

000, 

000, 

000, 

000, 

000 

), 

(* 

E 

*) 

( 

13, 

193, 

23, 

203, 

148, 

328, 

155, 

335, 

167, 

347, 

174, 

354, 

000, 

000 

), 

(* 

F 

*) 

( 

5, 

185, 

16, 

196, 

22, 

202, 

152, 

332, 

175, 

355, 

178, 

358, 

000, 

000 

), 

(* 

G 

*) 

( 

5, 

185, 

18, 

198, 

165, 

345, 

173, 

353, 

000, 

000, 

000, 

000, 

000, 

000 

), 

(* 

H 

*) 

( 

2, 

182, 

5, 

185, 

26, 

206, 

165, 

345, 

172, 

352, 

175, 

355, 

000, 

000 

)  ) 

VAR 

Last_RB, 

Teit|3_RB 

fRB  "" 

fDIAG 

RBfname 

i,j,k 

Inrec 

PBFileName 

RealTenp 

IntTenpl 

Code 

Radials 

NumberPadials 

frecjstr, 

MontiiNeane 

stationstr 


RB_Ptr;  {  station  range-bearing  data  list  ) 

text; 

text; 

string[40] ; 

integer; 

string  [80]; 

string  [40]; 

ireal; 

integer; 

integer; 

SortList; 

integer; 

String[3]; 
string[l] ; 


BEGIN 

{  Dispose  of  old  list  if  need  be  ) 
Iast_RB  :=  RB_List; 

WHUE  Last_RB~'o  nil  DO  BEGIN 
Tgnp_RB  :=  Last JRB^. next; 
Dispose  (Last_RB) ; 

Last_KB  TenpJRB; 

END; 


Generate  file  name  of  the  form  smmract.fff 
where; 

S  =  Sta  (A,B,  C,  D,E,F,G,H) 

mm  =  nonth  (EZB,JffiY,ADG,NOV)  (  4 

tt  =  on  (01.. 24) 

fff  =  frequency  (102  or  136) 


months  we're  concerned  with. 
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c^sesMcSTtii'-of- 


1 

MonthName-^ 

=•  'JAN'  ; 

2 

MonthName 

=  'FEB'; 

3 

MoithName 

=  'MAR'; 

4 

MonthName 

=  'APR'; 

5 

MonthName 

=  'MAX'; 

6 

MonthName 

=  'JUN'; 

7 

MonthName 

=  'JDL'; 

8 

MonthName 

=  'ADG'; 

9 

MonthName 

*  'SEP'; 

10 

MonthName 

=  'CXT'; 

11 

MonthName 

=  'NOV'; 

12 

else 

MonthName 

=  .'DEC'; 

MonthName  :=  'XXX'; 
end;  (*  case  stmt  *) 


str(freq:3,fxeqstr  ); 

stationstr  :*  chr(omd(digits[station])+16) ; 

RBFileName  :=  rbpath  + 

stationstr  + 

MonthName  + 
digits  [Off  DIV  lo]  + 
digitsCGMT  MDD  10]  + 

'.'  + 
freqstr; 


{$!“} 

Assign  (fKB,  RBFileName) ; 

Reset (fRB) ; 

{5B) 

if  (IQResult  =  0)  then  (*  no  error  *) 

begin 
writeln; 

Writeln( 'Reading  Range/Bearing  file  ',REFileName, '  .  . 

{Assign  Bearings  for  "Standard”  Raiials) 

For  i  :=  1  to  NUMS1ANDARD_RADIAIS  Do  (*  36  standard  radials  *) 
Radials[i]  ;=  10*(i-l);  (*  0..350,  every  10  degrees  *) 

I  **'*********'*********************-*****1»*******')**»'**'W*****  J 

{Input  Bearings  for  "Additional"  Radials  ) 

NumberRadials  :=  NUMSTANDARD_RADIAIS ; 
i  :=  1; 

While  (i  <=  NumberOfNonStandardRadials  )  and 
(NonStandardRadials  r station ,  i ]  o  0)  Do 
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BEJGIN 

Tia^i al  s [MiMSTANimRDj«^TAi54-i ]  :=  NonStandardRadials [Station,  i] ; 
Inc(i)  ; 

END; 


NumberRadials  :=  NUMSTANDARD_RADIAIS  +  (i-1)  ; 

{Sort  Radials  if  Necessaiy) 

If  (NumberRadials  >  NUMSTANDM?DjaDIAIS)  Then 
Qksort  (Radials ,  1,  NunbezPadials) ; 

^  *******************************  j 

(Process  Range/Bearing  Records: ) 

I  ***************************  *****  j 

Wirite('@')  ; 

for  j  :=  1  to  NumberRadials  do 
begin 

Write('. ') ' 

New(  Tenip_RB  ) ; 

Teiio_RB^ .NumAtoiis  ;=  NumberRecordsPerRadial; 

If  j  =  1  Then 
BEGIN 

RB_List  :*  TeiDp_RB; 

Last_RB  :«  RB__List; 

END  ~ 

EQ.se 

BEGIN 

Last_RB''.next  :=  Tenp_RB; 

Iast_RB  :=  Teirp_RB; 

END; 

Ten:p_RB^.RB, Bearing  :=  Radials[j] ; 

Fcr  i  :=  0  to  (NuniberRecordsPerRadial-l)Do 
BEGIN 

if  i  =  0  then  (*  if  processing  a  new  radial  then  *) 

begin  (*  read  past  the  6  lines  of  header  *) 

for  k  :=  1  to  6  do 
readln(fRB,  Inrec) ; 

end; 

Readln(fRB,  Inrec) ; 

Val(C:xiy(Inrec,l,4) ,  IntTeirol,  Cede); 
if  (Cede  =  0)  then 
Te!tp_RB^.RB.a[i]  .Range  ;=  IntTenrol 
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else'-" 

b^in-, 

writeln(i,j)  ; 

^jxri'telii(flog,  '***************  ^^  • 

writeln(flog,  ^Error  reading  Range  Bearing:  file:  '  ,RBFileNaine) ; 
writeln(flog,  'Attenpting  to  read  Range  values') ; 
writeln( flog, 'Radial  Nu2±)er  =  ',j:4); 
writeln(flog,  'Record  Number  along  Radial  =  ',i:4) ; 
writeln( flog, 'Radial  Bearing  *  '  ,Tenp_RB'^  .RB. Bearing: 4) ; 
writeln (flog, 'Value  read  in  fron  file  »  ''' ,Intrenpl:4, ; 
writeln(flcg,  'Range  has  been  assigned  the  value  of  zero. ') ; 
vffiiteln(flog,  '***************') ; 

Tenp_RB''.RB.a[i] .Range  :*  0; 
end; 


Val(Copy(Inrec,6,4) ,  IntTenpl,  Code);  {Short-path  Mode  1  Amp) 
if  (Cede  *  0)  then 

Te;p,_RB''.RB.a(i) .SHCLAnp  :*  IntTeirpl 
else 
begin 

writeln(i, j) ; 

writeln  (flog,  *'>>'>i*************') ; 

writeln  (flog,  'Error  reading  Range  Bearing  file:  ',RBFileName)  ; 

writeln  (flog,  'Attenpting  to  read  Short  Path  Mode  1  Anplitude') ; 

writeln  (flog, 'Radial  Number*  '/ji4); 

writeln(flog,  'Record  Number  along  Radial  *  ',i:4) ; 

writeln  (flog,  'Radial  Bearing*  ' ,  TenpJRB''  .RB.  Bearing;  4 ) ; 

writeln(flog, 'Value  read  in  from  file  »  ''',Int3tenpl:4, ; 

writeln(flcg,  'Short  Path  Mode  1  Anplitude  has  been  assigned  the  vsdue  of  zero. ') 

writeln (flog, '★**★*******★***/) ; 

Tenp_RB''.RB.aCi].SIMlAiip  ;*  0; 
end; 


Val(Ccpy(Inrec,ll,4) ,  IntTenpl,  Code);  {Short-path  Mode  1  Phase) 
if  (Code  *  0)  then 

TeaTp_RB^.RB.a[i] .SPMlEhase  :»  IntTenpl 
else 
begin 

writaln(i, j) ; 

writeln (flog, '  -x******^******  > ) ; 

writeln(flog, 'Error  reading  Range  Bearing  file:  ',RBFileNaine) ; 

writeln(flog,  'Attapting  to  read  Short  Path  Mode  1  Phase') ; 

writeln  (flog, 'Radial  Number  *  ',j:4); 

writeln(flQg,  'Record  Number  along  Radial  *  ',i:4) ; 

writeln  (flog, 'Radial  Bearing*  ',Tenp_RB''.RB,3earing;4) ; 

writeln  (flog, 'Value  read  in  from  file  =  ^ IntTenpl:  4, '^')  ; 

writeln(flog,  'Short  Path  Mode  1  Phase  has  been  assigned  the  value  of  zero. '} ; 

writeln  (flog,  '***»*****■*»■**★»') ; 

Te!p_RB''.RB.afij  .SPMlPhase  :=  0; 
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end; 


Val(Oopy(Inrec,16,4) ,  Intatenpl,  Code);  {Short-^th  Modesum  Anp) 
if  (Code  =  0)  tlvai 

'Itenp_RB^.J?B.a[i].SIMSuinAnp  :=  IntTenpl 
else 
begin 

writeln{i,  j)  ; 

Mri‘teln(flog^  ^  ***************  ^) ; 

writeln(flog/Error  reading  Range  Bearing  file:  '  ,RBFileNaine) ; 
writeln(flog,  'Attaipting  to  read  Short  Path  Mcde  Sum  Anplitude') ; 
writeln(flog, ^Radial  Number  «  ',j:4); 
writeln (flog, 'Record  Number  along  Radial  *  ',i;4); 
va:iteln(flog, 'Radial  Bearing  *  ',Tenp__RB''.RB.Bearing:4) ; 
writeln{flog, 'Value  read  in  from  file  *  ''',Intatenpl:4, '''') ; 

writeln(flog,  'Short  Path  Mode  Sum  Anplitude  has  been  assigned  the  value  of  zero. ') 
writeln ( flog, '******★******** • 

Tenp_RB''.RB.a[ij .SFMSuraAnp  :=  0; 
erd; 

Val{Ccpy(Inrec,21,4) ,  IntTenpl,  Code);  {Short-path  Modesum  Ihase} 
if  (Code  *  0)  then 

Tenp_RB''.RB.a[i] .SPMSumFhase  :«  IntTenpl 
else 
begin 

writeln(i,j) ; 

writeln (flog, '*************** ^) • 

writeln  (flog, 'Error  reading  Range  Bearing  file:  '  ,RBFileName) ; 

writeln(flog,  'Attenpting  to  read  Short  Path  Mode  Sum  Phase') ; 

writeln  (flog, 'Radial  Number  *  ',jJ4); 

wrlteLi (flog, 'Record  Number  along  Radial  »  ',i:4) ; 

writeln (flog, 'Radial  Bearing  «  ',Tenp_RB^. RB. Bearing: 4) ; 

writeln  (flog, 'Value  read  in  from  file  *  ^ ',  IntTenpl:  4, "'') ; 

writeln(flog,  'Short  Path  Mode  Sum  Phase  has  been  assigned  the  value  of  zero. ')  ; 

writeln ( flog , ' ***************  ^ ) ; 

Tenp_RB''.RB.a{i].SPMSuraPhase  :*  0; 
end; 


Val(Ccpy(lnrec,26,4) ,  IntTenpl,  Code);  (long-path  Modesum  Amp. ■ 
if  (Code  *  0)  then 

Tenp_RB'',RB.aCi].LPMSumAnp  :=  IntTenpl 
else 
begin 

writeln(i,  j) ; 

writeln (flog, '***************') ; 

writeln  (flog, 'Error  reading  Range  Bearing  file:  '  ,RBFileName)  ; 

writeln  (flog,  'Attenpting  to  read  Long  Path  Mcde  Sum  Anplitude')  ; 

writeln  (flog,  'Radial  Number  -  ',j:4); 

writeln(flcg,  'Record  Number  along  Radial  =  ',i:4) ; 
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writelh('flog,/Radial”fBearing:<if='''  ,T6!nc£HB?wRB.’Braring:4  )t; 
wrLteln(-flcgy'Vad\^«read».anpfran5?fia.e*?=  ■''^,Int33enpl:4';''^') ; 

writeinCflog,  'Long  Path  Mode  Sum  Anplitode  has  been  assigned  the  value  of  zero. ') ; 
writeln(flog, '*************** ; 

TenpJRB^.RB.a[i].LEMSumAiip  :=  0; 
end; 


END; 

IND; 

Last_PB^.next  ;s=-.nil; 
Close  (fRB) ; 


^  **********************  j 

{ 

Assign(fDIAG,  'DIAG-OTT")  ; 

Rewrite  (fDIAG) ; 

Tenp_RB  :»  RB_Iiist; 
voriteln; 

Writeln(fDIAG,  Tenp_RB^.NumAtans) ; 

While  (TenpJRBonil)  Do 
BEJSIN 

Writeln ,  Tenp_RB^ .RB. Bearing; 5) ; 

Writeln (fDIAG, Tempjffl''  .RB. Bearing; 5) ; 

For  i  ;»  0  to  (Terrojffi^  .NumAtcms-l)  Do 
Writeln(fDIAG,iJ5,Temp_RB^  .RB.afi]  .Range;5, 
Tenp_RB'' .RB.a(ii  .SPMlAlt?>;5, 
TenpJlB'' .RB.afij  .SHflLPhase;5, 
Ten?)_RB^.RB.a[i]  .SFMSumAmp;5, 
Ten5>_RB''.RB.aii]  .SHCun)Ehase:5, 
Teitp__RB‘'.RB,a[i]  .IIKSumftnp;5) ; 
Teirp_RB  ;=  Te!Tp_RB''.next; 


n®; 

aose(fDI?i3) ; 

) 

(  ***'********'Sit1lf*****'***  J 


end  {  Range/Searing  Processing  ) 

else  {  error  reading  file  } 

begin 

Writeln(chr(7) ////  Range/Bearing  file  ”',RBFileNaine, not  found  ///'); 

Halt(l) ; 
and; 
end; 
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•k  * 

*  JRDGRAM  JffiME  -  Ctnega  Performance  Assessment  * 

*  and  * 

*  C3overage  Evaluation  * 

*  (PACE)  * 

*  Wortetation  * 

*  * 

*  UNIT  NAME  -  Part  of  the  PACBOBJS  Unit  * 

*  * 

★A********************************************************************** 
*  * 

*  Uiis  program  vras  prepared  by  * 

*  ★ 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Wal3cers  Brock  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  catpatible  * 

*  under  MS-DCS  3.3  or  higher  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  catpatible  gr^iiics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DroS23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Onega  Navigation  System  Center  (OJSCEN) ,  Alexandria,  VA.  * 

*  * 

★★★★★lit****************************************************************** 
*  * 

*  PURPOSE  * 

*  This  file  contadns  the  methods  and  initialization  cede  * 

^  for  the  user  memo  input  window  that  is  used  for  user-input  * 

*  documentation  in  the  PACE  load  and  save  canmands.  * 

*  * 


★★********★*★**★*:***'*********★*'*****★■★★*★★★★*★***★*★★****★***★★★★******★  J 

constructor  MemcArea .  Init  ( InitX ,  InitY ,  InitFont ,  InitColor ,  InitHiLiteCol  or , 

InitTextColor,  InitHiliteTextColor, 
InitBorderColortword) ; 

{ 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Initialization  code  for  the  memo  text  input/edit  area.  * 

*  * 
********************************************************************  1»X***X 

) 

const 

InitBorderSize  =  4;  (*  pixel  border  around  MemcArea  ») 

InitNumChars  =50;  (’»  50  characters  per  lirte  *) 
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=  4;’  {*  -  4-lin^M3fi-texfe’*) 


var 

InitWidth, 

InitHeight 

0lc3Style 

i 


word; 

TextSettingsiVpe  ; 
integer; 


begin 

BorierSize 

Font 

NumChazs 

NumLines 


*  InitBorderSize;: 
=  InitFont; 

»  InitNumChars; 

*  InitNumLines; 


Color 

HiliteColor 


*  InitColor; 

:*  InitHiliteColor; 


TextColor  :=  InitTextColor; 
HilitefTextColor  :=  InitHilitefTextColor; 


GetTextSettings  (OldStyle) ; 
settextstyle(Font,horizdir,l)  ; 

TextLineHeight  ;»  textheight('l')  +4;  (*  pixels  above  and  below  *) 

InitWidth  ;*  NumQiars  *  textwidth('l')  +  BorderSize*2 ; 

InitHei^t  ;=  NumLines  *  TextLineHeight  +  BorderSize*2 ; 

BorderedArea.  Init  (InitX,  InitY,  InitWidth,  InitHeight ,  Initcolor, 
InitBorderColor,2) ; 

with  OldStyle  do  begin 

settext justify (Horiz, Vert)  ; 
settextstyle  (Font,  Direction,  CharSize) ; 
end; 


end; 


procedure  MenciArea.GetNewText(Text;CanrnentAreaType) ; 

{ 


*  * 

*  rURPCSE 

*  Methoa  to  place  altered  text  into  the  memo  object.  * 

*  * 


) 


var 
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i  :  integer? 
begin 

for  i  :=  1  to  NumLines  do 

MencCDext[i]  ;=  copy  (Text,  l+(  (i-1)  *^hM^lars) ,  i*NuinChars) ; 

end; 


procedure  MemQArea.AssignChangedText(var  TextrQximventArea'iype) ; 

{ 

**★★*****★**★******★**★****** ******************************************* 
*  * 

*  PURPOSE  * 

*  Method  to  save  the  text  that  is  currently  stored  in  the  * 

*  memo  object  so  that  we  can  retrieve  it  after  the  edit.  * 

************************************************************************ 


var 

i,j  :  integer; 

begin 
Text  := 

for  i  :*=  1  to  NumLines  do  begin 
for  j  ;=  length (Memdrext(i])+1  to  NumC3xars  do 
MemcText(i]  ;*  MemoTextCi]  +  ' 

Text:=  Text  +  MemcText[i] ; 
end; 
end? 


procedure  Memoftrea.Show; 

{ 

ic^*-x***********yi****ti**************->i***-)fK******ic**********************'x* 
*  * 

*  PCJRFOSE  * 

*  Method  to  display  the  memo  area  and  it's  current  text  * 

*  in  a  window  on  the  screen.  * 

•x**********************************************************-)e*********-x** 


i  :  integer; 

OldStvle  :  TextSertinosTvoe? 
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be^in*" 

Get_Cursorxy  (xx,yy) ; 

HidejCursor; 

Get3textSettings(01dStyle) ; 

settextstyle(Font,hori2dir,l)  / 

setcolor(TextColor)  ; 
settextjustifyClefttejAjCentertext) ; 
setfillstyle(solidf ill, color) ; 

BorderedArea .  show ; 

for-  i  :*  1  -to  Numl.ines  do  begin 
bar(X+BorderSize,  Y+BorderSizef  (i-l)*Te5CtidiieH^ 

X+Width-BorderSize,  Y+i-*TextLineHei^it) ; 
outtextxy  (X+BorderSize+1 , 

Y-fBorderSiz&f  ( ( i-1)  *Text.Tj.neHeight) (TextT .i neHeight  DIV  2), 
Meinorext[i]) ; 

end; 

with  OldStyle  do  begin 

settextj\astify(Horiz,Vert) ; 
settextstyle  (Font,  Direction,  CharSize)  ; 
end; 

Show_Cursor(X5c,yy) ; 
end; 


(*  ><><><><><><><>o<x>c><>c><>c><><><><><><><><><><><><><^^  *) 

procedure  MenciArea.Hilite(:5ftxs,Ypos;word) ; 

{ 

*******************■*********★****'******'********************•*******★***** 


*  * 

*  HJPPOSE  * 

*  Method  to  hii^ight  the  mamo  area  when  the  cursor  enters  * 

*  it's  area.  * 


******************************************************************************* 

\ 

1 

var 

i  ;  integer; 

OldStyle  :  TextSettingsType; 

begin 


(yipos  >=  X) 

AND 

(ypcG  <  X+Width) 

AND 

(Ypos  >=  Y) 

AND 

(Ypcs  <  Y-r-Height) 

IHEN 

BEGIN 

if  ncft(Kilited)  then  begin 
hide_cursor; 
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Hilited  uaUE; 

GetltextSettings(OldStyle) ; 

set±extstyle(Fc3rTt,hori2dir,l)  • 

setfillstyle(solidfill,hilitecolor)  ; 
setcolor(hiliteatexta3lor)  ; 
sette}rt:justify(lefttext,centertext)  ; 
for  i  :*  1  to  NumLines  do  begin 
bar(X+BortaerSi2e,  Y+BorderSi2e+(i-l)*TextLirieHei^t, 
X+Width-BorderSise,  y+BorderSizefi*TextLineIfeight)  ; 
outtextxy  (X+BorderSizet-l , 

Y+BorderSize+((i“l)*TejctLineHeight)+(TextLineHei<^t  DIV  2), 
Memofrext[i]) ; 

end; 

showM3ursor(3$»s,Ypos) ; 
with  OldStyle  do  begin 

sette}rt:justify(Hori2,Vert) ; 
settextstyle(Font,rirection,aiarSi2e) ; 
end; 
end; 

END 

ELSE 

IF  HiLited  THEN 
begin 

hilited  ;*  FALSE; 

Shew; 

end; 


end; 


*) 


procedure  MeIKA^ea.Hide^nleCursor(Line^hJm:  integer) ; 

{ 

*************************************************************************** 


*  * 

•*  HJRPCSE 

*  Met±iod  to  remove  the  text  cursor  fresn  the  indicated  line  * 

*  of  the  memo  area.  * 

*  * 


***•***■****************★*********★****•*•**■***********:((****•*•***********■***■* 

} 


begin 

IF  Hilited  THEN 

setcxjlor  (HiliteColor ) 
else 

setcolor  (Color) ; 

line  (X+BorderSize ,  Y-f BcrderSizerLir^am’'C?extLineHei^.t-l , 

X-HVidth-SorderSize,  Y-r5orderSi2e^-LineNum*TextLineKei!^t~l) ; 
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procedure  Ms!moArea.Shcv®ieCrirsor(LineNum,CursorPosi1:ion:integer) ; 
{ 


*  * 

*  KRPCSE  * 

*  Method  to  draw  the  text  cursor  at  the  appropriate  line/  * 

*  character  in  the  memo  area.  * 

*  * 


************************************t(»f*********************************** 

) 


var 

xl  ;  integer; 
begin 

xl  :=  X  +  BorderSize  +  (CursorPosition  *  texcwidth('l') )  ; 
line  (xl-textwidth('l')  / 

Y+BorderSizef LineNum*TextLineHeight“l , 
xl, 

Y+BorderSize+IineNun*TextIineHeight-l) ; 

end; 


var 

OldStyle  ;  TextSettingsIVpe; 
begin 

GetTexcSettings (OldStyle) ; 

IF  Hilitsd  UiEN  begin 
setxx3lor(HiiiteColor) ; 
serf illsT:yle(solidf ill, HiliraColor) ; 
end 
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else  begin 
setxx)lor(Color) ; 
setfills1^1e(solidf ill.  Color)  ; 
end; 


settext:style(Font,horizdir,l) ; 

■  settextjustify(lefttext,cent:ert:ext) ; 

{*  hide  the  edit  cursor  and  erase  old  text  with  the  badoground  color  *) 
HideflheCursor(LineNum) ; 

if  Display_String[LirieNum]  o  NeWItext[LineNuin]  then  begin 
bar(X+BorderSi2e,  Y+BorderSizef  ( (LineNum-1)  *TextLineHei^t) , 

X+Width-BorderSize,  Y+BorderSi2e4-(  (LineNum)  *TextI ,i neHeight ) ) ; 
Display_StringCLineNum]  ;=  NewTexc [LineNum] ; 
end; 


if  Hilited  then 
setcolor  (HiliteTextColor ) 
else 

setcolor  (TextColor) ; 
outtextxy  (X+BorderSizefl , 

Y+BorderSizef((LineNun^'l)*TextLineHei^t)+(TextLineHei(^t  DIV  2), 
Display^StringfLineNum] ) ; 

Shcx^eCursor (LineNum,  QjrsorJPosition) ; 

with  OldStyle  do  begin 
settextj\astify(Hbriz,Vert) ; 
settextstyle  (Font ,  Direction ,  CharSize) ; 
end; 
end; 


function  MerxaArea. Action (}^»s,Ypos  ;  word);  boolean; 

{ 

************************************************************************ 


*  * 

*  HJHFOSE  * 

*  Jfethcd  to  handle  the  editing  of  text  in  the  memo  area.  » 

*  * 


) 


const 

CEL  =  210; 
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HCMEe  =-i98-7- 
END_  =  206; 

CEra^END  =  244; 

var 

tnp  ;  string[l] ; 

Tenffltext  :  Meia^ItejitlVpe; 

CursorPosition, 

LineNum, 

button  :  Integer;, 

begin 

Action  :*  FALSE; 

if  Control . Action (3$x»,Ypos)  then  begin 
HidejCursor; 

Action  :*  true; 

for  i  :=  1  to  NumLines  do  begin 
Display_StriDg[i]  :=  Meinorext[i3 ; 

Ten?fl3ext[i]  :»  Menr0sxt[i3  ; 

end; 

CursorPosition  ;=  1; 

LineNum  :=  1; 

r^»at 

DisplayText  (TenpText,  LineNum,  CursorPosition) ; 

key  :*  0; 
button  :=  0; 

while  (key  =  0)  do  begin 
get_key(key) ; 
button  ;»  get_buttons; 
if  (button  =  left_button_pressed)  then 
key  :=  enter; 

if  (button  =  right_button_pressed)  then 
key  esc; 

end; 


case  key  of 

BACKSPACE  ;  begin 

if  (CursorPosition  >  1)  then  begin 
delete  (Tenc^rextrLineNum] ,  CurscrPcsition- 
dec (CursorPosition) ; 
end 

else  begin 

if  (UneNum  >  1)  then  begin 
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DEL 


HCME 


Etro 


CIRL_END 


UP  ARROW 


d:wn_arrow 


HidfillieCursorCLineNi^  ; 
dec(Linf^^) ; 

CursorPosition  :=  NumChars; 
delete (Tenffltext[IdjieNum],  CursorPosition,  1) ; 
end 
else 
be^; 

end; 

end; 


;  begin 

if  (Teii|nfext[lJj:«Num]  [CiirsorPositim^  o  *')  then 
delete (TarffText [LiiieNum] ,  CursorPosition,  1) 
else 
beep; 

end; 


:  begin 

CursorPosition  :=  1; 
end; 


:  begin 

CursorPosition  :*  length (Te^c^^ext[IdJle^hJm 
if  CursorPosition  »  0  theai 
CursorPosition  ;»  1; 

end; 

:  begin 

delete (TeIt?fPext[Iine^^3m], CursorPosition, NuniQiars) ; 
end; 


begin 

if  LineNum  >  1  then  begin 
Hid€fIheCursor(LineNum) ; 
dec  (LineNum) ; 
end 
else 
be^; 

end; 


begin 

if  LineNum  <  NumLines  then  begin 
Hide(IheCursor( LineNum) ; 
inc  (LineNum) ; 
end 
else 
beep; 

end; 
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if '  (OxcTOrPosition  >'1)  thfeh 
dec(CursorPositicxi) 
else 

if  (Lin^tum  >  1)  then  begin 
HideXheCursor(LineNum) ; 
dec(LineNum) ; 

CursorPositian  :«  NumChars; 
end 

else  beep; 

end; 


RIGHTJ^RCW  :  begin 

if  (CursorPosition  <  NumQiars);  then^. 

inc  (CursorPosition) 
else 

if  (Lin^han  <  NumLines)  then  begin 
HideflheCursor(LineNum) ; 
inc(LineNum) ; 

CursorPosition  :=  1; 
end 

else  be^:; 

end; 

else  begin 

if  (chr(3cey)  >=  '  ')  and  (chr()cey)  <*  'z')  then  begin 
tap  ;*  dir()?ey) ; 

if  CursorPosition  >  length  (TenpOteJcttLiiieNum])  then 
for  i  ;»  length(TenpItext[LineNuin] )  to  CursorPosition  do 
insert  ( '  * ,  TerrpText  [LineNum] ,  CursorPosition) ; 
insert  (tap,  TeiipText  [LineNum],  CursorPosition) ; 
if  (CursorPosition  <  NumChars)  then 
inc  ( CursorPosition) 
else  begin  ^ 

Displayrext(Tettp/rext,  LineNum,  CursorPosition) ; 
HideJIheCursor  (LineNum) ; 
inc  (LineNum) ; 

CursorPosition  :=  1; 
end; 
end; 

end;  (*  of  case  statement  *) 
end; 

until  ( (  key  =  ENTER  )  or  (  key  =  ESC  ) ) ; 


Kide(IheCursor  (LineNum) ; 

if  (key  =  ENTER)  than  begin 
for  i  :=  1  to  NumLn^es  do 
Memc/rexc[i]  :=  TenpfTextri] ; 
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end; 


(*  rewrite  the  meanD  area  with  the  original  text  *) 

if  (Icey  =  ESC)  then 
for  i  :*  1  to  NumLines  do  begin 
DisplayText(MeiBdrext,i,aasorBc!sition) ; 
Hide?IheCursor(i) ; 
end; 


Show_Cursor(Xixis,Ypos)  ; 
end; 
end; 
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*  *'■- 

*  FFCGRAM  NftME  -  Qcega  Perf  onnance  Assessment  * 

*  and  * 

*  Coverage  Evaltation  * 

*  (PACE)  * 

*  Wortetaticjn  * 

*  * 

*  UNIT  NAME  -  PACE  IR3GRAM  * 

*  * 
**:Hr******i*r*********il^r******************i'r^*********ilp********************** 

*  ’  * 

*  Diis  program  'Was  ,prq3ared  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  carpatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  miniinum  of  640K  of  main  * 

*  memory  and  an  EGA  or  cetpatible  grz^iiics  adapter  and  color  * 

^  monitor.  Ihis  v«rk  was  performed  under  contract  number  * 

*  Dr0323-89-C-20008,  Task  Order  90-0001,  Tas},c  No.  5834,  for  * 

*  the  Croega  Navigation  System  Center  (C^JSCH'I) ,  Alexandria,  VA.  * 

*  ★ 

★  ★ 

*  HJRPOSE  * 

*  Hiis  file  contains  the  main  routine  of  the  PACE  workstation* 

*  code.  It  handles  the  initialization  of  all  PACE  objects  * 

*  contexts  and  taj  lists  and  contains  the  main  action  * 

*  dispatch  loop.  * 

*  * 


**-i'?**********************w**'><(***'************^t*********>'x*x**'jit************  J 

{$N+-,E+) 

program  Performance_Assessment_Coverage_Evaluator; 

Uses  PaceInit,Crt,CursrObj,Grc^,ErrL:g,CellUtil,?2^Util,WorldMap, 

Controls ,  ConMan ,  Pacecbj  s ,  Procs ,  TascLogo ; 


VAR 

grscde ,  grdriver :  integer ; 

X,  Y,  Initindex;  integer; 

button: integer; 

key;  integer; 

first:  word; 

ma:lcngint; 

avail : shortstrirg ; 


F-184 


File  Name:  PACE. PAS 


Begin 

Grtiriver  :=  Detect; 

Initgr2^(grdriver,gnicde, ; 

Setgraphnode(EGfiHI) ;  (*  640  x  350  *) 

Displaylogo; 


(* 

ma  :=  memavail; 
str(ina,aveiil) ; 

Log_Erxor( 'memory  avail  =  '+avail) ; 
ma  ;*  maxavail; 
str(ina, avail) ; 

Icg_Error('max  avail  =  '+avail) ; 

*) 


InitWorldMap; 

InitCellGrid; 

ri^teiqjanded  ;»  FALSE;  {  start  off  with  the  left  edit  menu  ) 
lefteijqsanded  ;»  HUE; 


SetActiveFage(l) ; 

{  base  screen  and  controls  } 

new(basescreen,Init(0,0,639,349,  blue,  v^te,l)); 

new(BIQnap,Init(37,20,564,278,  blue,  white)); 

new(BIGCellGrid,  Init  (37 , 20,564 , 278 ,  BigCellGridAction,ShowCellData, 

DoNothingProc,  blue,  red,  lightgray,  yellow) ) ; 

new(basescreen2, Init (0,0, 639, 349,  blue,  whits,!)); 

new(BIQnc^2,Init(37,20,564,278,  blxie,  lightgray)); 

newCWeigfatCellGrid,  Init  (37 ,20,564, 278 ,  WeightsCellGTidAction , 

DrawCells)Wei^TtsCellGridCancel,  blue,  red,  lightgray,  yellow) ) ; 
new(CoverageCellGrid,  Init  (37 , 20 , 564 , 278 ,  CoverageCrllGridAction, 

ShcwCoverageCel IData , DoNothingProc ,  lii^tblue,  red,  liyntgray,  yellow)); 
new(dif f CellGrid,  I-nit  (37 , 20 , 564 , 278 ,  Dif  fCe.1  iGridAction, 

Sheriff CellData , DoNothingProc ,  li^tblue,  red,  li^rgray,  yellow)); 

new(h,Init(25,4,60,16,white,black,bladc,whita,  'Help'  ,helpbutron,  'H') ) ; 
new (q, Init (105, 4, 60, 16, v^te, blade, black, whirs,  'Quit' ,quitbutton,  'Q') ) ; 
new (f, Init (185, 4, 60, 16, white, black, black, whits,  '?iie',fiIefautton,  'F')) ; 
new (s, Init (2 65, 4, 60, 16, white, black, black, whits, ' Split ',splitbutton,  'S')) ; 


F-185 


File  Name:  PACE.PAS 


ne^{o, Init(185>4;70,16;white, black, ^lack, white,  'Options' ,cptionsbiitton,  'O') )  ; 


{  options  file  menu  for  the  weights  screen  } 
opticnsmenunamelist[l]  'Grxxp'; 
optionsmenunaiBelist[2]  :*  'Region'; 
qjticnsjnenunainelist[3]  ;*  'load'; 
aptionsmenunamelist[4]  'Save'; 
c:ptiansinenuhotkeylist[l]  :*  'G'; 
cptionsmenuhotkeylist[2]  ;»  'R'; 
optionsinenuhotkeylist[3]  :=  'L'; 
cptionsinenuhcttki^list[4]  ;=  'S'; 
cptionsaieruyrooedurelist [  1]  WeightsGroi^Button; 

cptiansnern:prtx»durelist[2]  :*  Weight_or_Region_Button; 
optionsineni^roc8durelist[3]  :«  Wei^tsloadbutton ; 
oj^ionsnentprocectjreli^  :*  Wei^tsSaveButton; 

new  ( c^tionsmenu ,  Init  ( o'' .  X ,  .  Y-Hy' .  Height+5 , 4 ,  qjtionsmenunamelist , 

cptionsmenuprocedurelist,optionsmenuhotJceylist) )  ; 
new(Weightslistmenu,  Init  (227 , 83 ,  cyan,  black,  Weightslistmenuview, 

Weightslistmenuaction,WEIGaiSPAIH+'\',  '*.*') ) ; 

new(r,Init(275,4,60,16,white,black,black,white,  'Return',  retumbutton,  'R') )  ; 
new(cr,Init(185,4,60,16,white,black,black,white,  'Return' ,  CoverageRetumBurton,  'R') )  ; 
new(dr,Init(ia5,4,60,16,white,black,black,white,  'Return' ,  DifferenceRetumButton,  'R') )  ; 
new(Weiq^tsSaveMenuWindcw,  Init  (110, 145 , 418 , 100,  cyan,black,  white, black, 

black,  black,  white ,  def  aultf cnt ,  WeightsSaveAction , 

")); 

Wei^tsSav^tenuWindw''. Title  :■=  'Wei^ts/Region  File  Annotation'; 


{  split  screens  and  controls  ) 

new(leftsplit,lnit(0, 21, 319, 328, lightblue, white, 1) ) ; 
new(LEFTinap,  Init(35,24,28l,314,li^tblue,w’hite) ) ; 

new(IEFTCellGrid,  Init (35 ,24,281,314, LeftCellGridAction, ShowCellData,  DC^othingProc, blue ,  r 
new ( ri^tspl it, Init (320,21,318,328, lightblue, vmite,  1) )  ; 
new(RI(3mnap,  Init:(323,24,281,314,lightblue,white) )  ; 

new(RIC3HrCellGrid,  Init (323 , 24 , 281, 314  ,RichtCeliaidAction, ShowCellData ,  DoNothingProc, blu 
new  ( leftesqxind ,  Init  ( leftsplit-' .  X+105 ,  leftsplit^ .  y+4 , 60 , 16 ,  vAiite ,  black, 

black, vrtute,  'Expand'  ,leftexpandbuctcn,  'E') ) ; 
new  ( righte:roand ,  Init  ( richtsplit^ .  X-105 ,  rightsplit-' .  Y--4 , 60 , 16 ,  white ,  black, 

black, white,  'eJQ»nd' , rightexpandbutton ,  'X') ) ; 
new(lf  ,Init  (leftsplit''  .X+25,  leftsplit''  .Y-t-4, 60, 16,white,black,black,wiite, 

'File' ,  leftfilebutton,  'F' ) ) ; 

new(rf ,  Init  (ri^tsplit-'  .X+25 ,  rightsplit^ .  Y+4 , 60, 16,  white,  black,  black, 
white,  'fIle',ri(^tfilebutton,'I')) ; 

new(difference,Init(265,4,105,16,\^ta,black,black,white,  'Difference'  ,differsncebutton,  'D 
new(difference2,Init(265,4,105,16,white,black,black,whita,  'Difference'  ,differancar:uttan, ' 


{  file  and  auxiliary  (right  split)  file  menus  ) 
filenenunameiistri]  :=  'Lead'; 
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f ilemenunamellst [ 2 ]  :=  'Save'; 
f ileroenunamelist [ 3 ]  ;=  'Edit'; 
f ileroenunamelist [4 ]  ;=  'Batch'; 
fileroenuhot3ceylist[l]  :=  'L'; 
filaaenuhot3csylist[2]  :=  'S'; 
fileroenuhot3ceylist[3]  ;=  'E'; 
filenfinuhotkeylist[4]  :=  'B'; 
fileroenuprocedurelist[l]  :=  loadtxttton; 

file!nenuprocedurelist[2]  :*  savebutton; 

filemenuprocedurelist[3]  :=  editbutton; 

filement?5rocedurelist[4]  processbatchqueue; 

new(f  ilemenu,  Init  ( f  *  .X,  f  ^ .  Y+f''  .Height+5 , 4 ,  filemenunamelist , 

filemeni^5rocedurelist,filemenuhc3t)ceylist) ) ; 
new  ( leftf ilemem ,  Init  ( 1£^ .  X+15 ,  If ^ .  Y+lf ^ .  }feight+5 , 4 ,  filemenunamelist , 

filemenuprccedurelist,filemenuhoc3ceylist) )  ; 

filemenuprtx:edurelist[l]  :=  aujdoadbutton; 

filemenuprocedurelist[2]  :*=  auxsavebutton; 

filemenuprocedurelist[3]  :=  auxeditbucton; 

f ilememprocadurelist  [  4  ]  ;  =  auxprocessbatchqueue ; 

new(ri^tf  ilemenu,  Init  (rf  ^  .X,  rf  ^ .  Y+rf^  .Height+5 , 4 ,  filemenunamelist, 

filemenuprocedurelist,filemenuhotkeylist) ) ; 


{  primary  and  auxiliary  (left  &  right  split)  list  menus  ) 

new(  listmenu,Init(227,83,cyan,bladc,listmenuview, 

listmenuacnion,ARCHrVEPAIIri-'\', '*.*') )  ; 
new(  ri^tlistmenu,  Init  (227 , 83 ,  cyan,  blade,  rightlistmenuview, 

rightlistmenuaction,ARCHIVEPAIH+'\',  '*.*')) ; 

{  edit  and  auxiliary  (right  split)  edit  menus  ) 

new(  editmenu,Init(54,100,  ?eliabilityActicn,Weight.\cticn,Queua4ction, 

edi-cnenuprccess) ) ; 

new  ( auxeditmenu ,  Init  (54,100,  AuxReliabilityAction ,  AuxWeightAction ,  AuxQueua^iction , 

auxeditmemrorocess ) ) ; 


new(  diffmenUi.Lnit(180,25,  differanceacceptbutton) ) ; 


new(  PeliabilityListMenu,Init(editmenu''.Hsliabilit%\X-5, 

editmenu''  .Peliabiliry .  Y-i75 , 
cyan ,  black,  reliabilitymenuview , 
SelIistManuAction,QR?AZH^'\' ,  '».*') }  ; 
na'/(AuxR£iiabilityLisdfenu,  Init  (auxeditmenu^  .Psiiability.x+5, 


auxeditmenu-' .  Reliability' .  Y-175 , 
cyan,  black,  auxrsliabilitymenuview , 
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AiaRellisOfenuAction ,  C2RPA03ff '  \  ^  '  * .  * '  ^ 

new(leftlcwerstatus,Init{3, 296, 309, 49 ,blac}c, white, editmenu) ) ; 
new(rightlcwerstatus,Init(327, 296, 309, 49, black, white, auxeditmenu) ) ; 

new(leftsidestatus,Itut(3, 52, 30, 244, black, white, editmenu) ) ; 
new(rightsidestatus ,  Init ( 606 ,52,30, 244  ,black, white, auxeditmenu) ) ; 

new(CellPoFOp ,  Init  (150,21, 172 , 271 ,  li^bgray,  black,  black,  yellcw,  white , 

SubCellAction,ShowCellData,red,editmenu) ) ; 
new(SubCellPopUp ,  Init  (150 , 23 , 150 , 48 ,  lightgray,  black,  black,  yellcw,  CoverageAction) ) 

new(DiffCellPopUp,  Init  (150,21, 170, 60,  lightgray,  black, 

black, yellow, white) ) ; 


new  ( SaveMenuWindcw ,  Init  (110,145,418,100,  cyan,  black,  white ,  black, 

black ,  black ,  white ,  def  aultf ont ,  SaveAction , 

new  (AuxSaveJfenuWindcw,  Init  ( 110 , 145 , 418 , 100 ,  cyan,  black,  white ,  black, 

black ,  black ,  white ,  def  aultf  ont ,  AuxSaveAction , 

new(QueueSaveMenuWindow,  Init  (110, 145, 418 ,100,  cyan, black,  white, black, 

black,black,  white,  defaultfont,  QueueSaveAction, 
"))> 

n0*i  (AuxQueueSaveMenuWindcw,  Init  ( 110 , 145 , 418 , 100 ,  cyan,  black,  white,  black, 

black ,  black ,  white ,  defaultfont ,  AuxQueueSaveAction , 
")); 

new  (HelpMenuWindow ,  Init  (50,25,540,300,  cyan,  black,  white ,  black,  white , 

defaultfont, NextAction,Previou£Action) ) ; 


new (stufcvdndcw,  init)  ; 

SetActive?age(0) ; 

createconcexc(  'basescreen' ) ; 
addtocontext(  'basescreen'  ,basescreen)  ; 
addtocontext('basescreen',h) ; 
addtocantext(' basescreen ',q) ; 
addtocontaxt( 'basescreen'  ,f) ; 
addtccontext( 'basescreen' ,s) ; 
acdtcccntaxt(  'basescreen' , leftlcwerstatus)  ; 
addtccontext(  'basescreen' , leftsidestarus) ; 
aGdtccontaxt(  'basescreen' ,  BIGCellGrid) ; 
addtcconcext(  'basescreen' ,  BKatep) ; 
addtctablist'  'basescreen'  ,h) ; 
addtotablist  ( 'basescreen' ,  q)  ; 
addtctablist ( 'basescreen' ,  f ) ; 


F~188 


File  Name:  PACE. PAS 


addtotablist(  'basescreesn^  ,s)  ; 

cxeateccaTtext('filemenu') ; 
addtxx»ntext( 'fileanenu^ , filemenu) ; 
a<iatcxxaitext('filenienu'/h) ; 

addtxxMntejctC ' fileirenu' , q) » 

addtotablist( 'filemenu^ , efilemenu''.but±onarray[l] ) ; 
aci3totablist( 'filemenu' , gfilemenu'' .]xit:tonarray[2] ) ; 
ac3dtotablist( 'filemenu' ,  @fileroenu^ .iiuttonarrayfS] ) ; 
addtx)tablist( 'filemenu', @filemenu^.buttcfnarray[4])  ; 
addtotablist(' filemenu'  ,h) ; 
addtotablist ( ' filemenu' ,  q)  ; 

createcx5nt:ext('left:filemenu') ; 
addtoccntext  ( '  leftf ilemenu ' ,  leftf ilemenu) ; 
addtocontejct  ( '  leftf  ilemenu'  ,h) ; 
addtccxintext ( 'leftf ilemenu' ,  q) ; 

addtotablist ( 'leftf ilemenu' ,  @leftfilemenu''  .buttonarray [1] )  ; 
addtotablist  ( '  leftf ileienu ' ,  @leftf ilemenu'' .  buttonarray  [  2  ] ) ; 
addtotablist ( 'leftf ilemenu' ,  @leftf ilemenu''  .buttonarray [3 ] )  ; 
addtotablist  ( '  leftf  ilemenu ' ,  @leftf ilanenu'' .  buttonarray  [  4  ] ) ; 
addtotablist ( 'leftf ilemenu' ,h) ; 
addtotablist  ( '  leftf  ilemenu' ,  q) ; 

createcontext  ( '  rightf ilemenu ' ) ; 
addtocontext  ( '  rightf ilemenu ' ,  rightf ilemenu) ; 
addtaxintext('rightf ilemenu'  ,h)  r 
addtocontext  ( '  rightf  ilemenu ' ,  q) ; 

addtotablist  ( '  rightf  ilemenu ' ,  @rightf ilemenu'' .  buttonarray  [  1  ] ) ; 
addtotablist  ( '  ri<^tf ilemenu ' ,  @rightf iJ.eroenu^ .  buttonarray  [  2  ] ) ; 
addtotablist ( 'rightf ilemenu' ,  @rightfilemenu^ .buttonarray [3 ] ) ; 
addtotablist ( 'ri^tf ilemenu' , @rightfilemenu^ .buttonarray[4] )  ; 
addtotablist ('rightf ilemenu' ,h) ; 
addtotablist  ( '  rightf  ilemenu ' ,  q) ; 

crsatecontext ( ' splitscreen ' ) ; 
addtocontext ( '  splitscreen' ,  Leftsplit) ; 
addtocontext  ( '  splitscreen ' ,  Ri^tSplit ) ; 
addtocontext. ( 'splitscreen'  ,h) ; 
addtocontext ( 'splitscreen' ,  q) ; 
addtocontext  ( '  splitscreen ' ,  difference) ; 
addtocontext ( 'splitscreen' , leftlowerstatus)  ; 
acdtocontext  ( '  splitscreen ' ,  rignclowerstatus ) ; 
addtocontext ( ' splitscreen' ,  leftsidestatus) ; 
addtoconcext  ( '  splitscreen ' ,  richtsidestatus ) ; 
addtocontext ( 'splitscreen'  ,leftexpand) ; 
addtocontext  ( '  splitscreen ' ,  rightesxpand)  ; 
acdtocontext  ( '  splitscreen ' ,  If) ; 
addtcconcaxt(  'splitscreen' , rf) ; 


I 
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adit»cxjntext( 'splitscreen'  ,IZFreellGrid) ; 
addtccrgTtext  ( ^splitscreen^  ,PIGarCellGarid)  ; 
addtxxxaTtext('^litscxeen',IirDnap) ; 
addtocxantext  ( 'i^litscxeen'  ,PIGHrmap) ; 
addtotablist(  'splitscxeen^ , difference) ; 
addtotablist ( 'splitscreen' ,  If) ; 
addtotablist  ( '  ^litscxeen' ,  leftexpand)  ; 
addtotablist  ( 'i^litscieen' , rf )  ; 
addtotablist  ( '^litscreen' ,  rightexpand)  ; 
addtotablist ( 'splitscreen'  ,h)  ; 
addtotablist(  'splitscreen'  yq) ; 

createcontext('editmenu') ; 
addtocontext('editmenu'  ,editmenu) ; 
adatocs3ntext('editmenu',h)  ; 
addtocontext('editmenu',q)  ; 
addtotablist('editmenu',§editmenu^.Psa. value) ; 
addtotablist ( 'editmenu' ,  geditmenu'' .SNR. value)  ; 
addtotablist  ( '  editmenu' ,  Seditmenu'' .  ShortLongRatio .  value) ; 
addtotablist ( 'editmenu' , @€ditmenu'' .XAngle. value) ; 
addtotablist  ( '  editmenu ' ,  @editmenu'' .  IbaseDev.  value) ; 
ad3totablist( 'editmenu'  ,@editmenu^.C2X3P. value) ; 
addtotablist( 'editmenu' , @editmenu'' .IM.ButonArray [1] ) ; 
addtot2±)list( 'editmenu' ,@editmenu^.i:M.ButtonArray [2 3) ; 

adidtot2±»list(' editmenu', @editmenu''.PsaCalculateMode.buttonarray[l]) ; 
addtotablist ( 'editmenu' , @€ditmenu''.PsaCalculatelfcde.buttonarray[2] ) ; 

addtotablist ( 'editmenu' ,  @€ditmenu''  .PsaReport^^ode.buttonarray[l] ) ; 
addtotablist('editmenu',§editmenu''.PsaRi^rtMode.buttcinarray[23) ; 
addtotablj^(  'editmenu' ,  @€ditmenu''  .PsaRqportMode.buttonarray[3] ) ; 
addtotablist  ( '  editmenu ' ,  §editmenu^ .  StationReliabilityftodel .  buttonarray  f  1  ] ) ; 
addtotablist  ( '  editmenu ' ,  @editinenu^ .  StationReliabilityModel .  buttonarray  [  2  ] ) ; 
addtotablist  ( '  editmenu ' ,  @€ditmenu'' .  StationReliabili't^'Model .  buttonarray  [  3  ] ) ; 
FOR  initindex  :=  1  TO  8  DO 
begin 

addtotablist ( 'editmenu' ,  @€ditmenu'' .StationPcwer [initindex]  .Sid. Value) ; 
addtotablist  ('editmenu' ,  @€ditmenu''.StationPower[  initindex]  .Off) ; 
addtotablist ( 'editmenu' , geditmenu'' .StationPower[ initindex]  .On) ; 
end; 

addtotablist ( 'editmenu' ,  @€ditmenu^ .Freq.buttonarray[l] ) ; 
addtotablist ( 'editmenu' ,  §€ditmenu'' .Freq.buttonarray[2] )  ; 
addtotablist('editmenu',@editmenu''.Freq.buttcnarray[3])  ; 
addtotablist ( 'editmenu' ,  @€ditmenu^ .Free. buttonarray [4] ) ; 

FOR  initindex  :=  1  TO  12  CO 

addtotablist ( ' editmenu' ,  @€ditmenu''  .McnthSelectors [ initindex] ) ; 

FOR  initindex  :=  1  TO  24  CO 

addtotablist ( ' editmenu' ,  §editmenu^  .HoorSelectors [ initindex] ) ; 
addtotablist  ( '  editmenu' ,  @editmenu''  ,Re,liability) ; 
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adtotablist  ( ^editnienu/ ,  gedj-btenu^  .Wei^ts)  ; 
addtotablist ( 'editjnenu' ,  §editmenu''  .Batch) ; 
a(iatotablist(  'editmenu' ,  geditmenu^ . Process) ; 
addtot2i3list('editinenu^,h) ; 
acidtotablist ( 'editmenu' , q) ; 

createcontext  ( *  auxeditmenu^ ) ; 
euiitocontext(  'auxeditinenu'  ,auxeditinenu) ; 
addtocontext(  ^aiixeditmenu^  ,h) ; 
addtocontext  ( 'auxeditmenu^ , q)  ; 

addtotabList('auxedit3nenuS@auxBditit>enu''.Psa. value)  ; 
addtotablist ( 'auxeditmenu' ,  @auxeditineru''  .SNR. value)  ; 
addtotablist ( 'auxeditsenu' ,  gauxeditmem-'  .ShortLon^tio. valiie) ; 
adltotablist ( ^aioeditmenu' ,  §auxeditinenu''  .XAngle.valiie)  t 
addtotablist  ( 'auxeditmenu' ,  gauxeditmenu'^ . IhaseDev. value) ; 
addtotablist('auxeditinenu',gauxedittnenu''.aiDP.value) ; 
aciltotablist ( 'auxeditnvenu' , gaiDceditmem^ .IM.ButtonArray[l] ) ; 
addtotablist('auxeditiiem',gauxeditinenu''.EM.ButtonArray[2]) ; 

a(ihxjtablist ( 'auxeditmenu' , ga\Keditinem''.PsaCalculateM3de.lxittonarray[13 )  ; 
addtotablist ( ^auxeditanenu^ , gauxeditinem^ .l^caiculate»fa3e.]xittonarray [2] ) ; 

addtotablist ( 'auxeditmenu' , gauxeditaem'^ .PsaReportMxie.jxittonarrayCl] ) ; 
addtcftablist  ( 'auxeditaienu' ,  gaiixeditinem^  .PsaR^rtMode.ixittanarray [ 2  ] ) ; 
addtotablist  ( 'auxeditaenu' ,  gauxeditaero^ .PsaR^rtMcde.buttomrray[ 3 ] )  ; 
addtotablist  ( '  auxeditaenu ' ,  gauxeditaenu'' .  StatioriReliabilityMbdel .  buttonarray  [  1  ] ) ; 
addtotablist(^axjxeditaenu' ,gai2xeditaenu^.StationReliabilit^'Mcdel.buttonarray[2])  ; 
addtotablist ( 'auxeditaenu' ,  gauxeditaenu^ . StationReliabilityMcdel. buttonarray [3 ) )  ; 
FDR  initindex  :»  1  TO  8  DO 
begin 

addtotablist ( 'auxeditaenu' ,  gauxeditaenu'' .StationPcwer[ initindex]  .Sid. Value) ; 
addtotablist( 'auxeditaenu' ,  gauxeditaenu^.StationPcwer[ initindex]  .Off) ; 
addtotablist ( 'auxeditaenu' , gauxeditaem^ .StationPower[initindex]  .On) ; 
end; 

addtotablist('auxeditaenu' ,gauxeditaenu^.Freq.buttonarray[l]) ; 
addtotablist  ( '  auxeditaenu ' ,  @auxeditaenu^ .  Freq.  buttonarray  [  2  ] ) ; 
addtotablist('auxaditaenu'  ,gauxeditae.nu''.Freq.lxittonarray[3]) ; 
addtotablist  ( '  auxeditaenu ' ,  gauxeditaa.nu'' .  Freq.  but .'xjnarray  [  4  ] ) ; 

FOR  initindex  :*  1  TO  12  DO 

addtotablist ( ' auxeditaenu' ,  gauxeditaenu-'  .MonthSelectors  [ initindex] ) ; 

FOR  initindex  ;=  1  TO  24  DO 

addtotablist  ( '  auxeditaenu' ,  gauxeditaenu''  .HourSelectors [ initindex] ) ; 
addtotablist  ( '  auxeditaenu' ,  gauxeditaenu''  .Reliability) ; 
addtotablist ( 'auxeditnena' ,  gauxeditaenu''  .Weights) ; 
addtotablist  ( '  auxeditaenu ' ,  gauxeditaenu'' .  Batch) ; 
addtotablist(  'auxeditaenu' ,  gauxeditaenu'' .Process) ; 
ajddtctablist(  'auxeditaenu'  ,h) ; 
addtotablist  ( '  auxeditaenu ' ,  q) ; 
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createcante}ct('dif&>enu^/)  i 
addtoccntext:(  ^diffmenu^^-^'dif:^^  ; 
addtoccntfflct  ( 'diffmenu'  ,h)  ; 
adiitMconte5{t('ciiffinenu^,q) ; 

addtotabllst(  ^diffmenu' ,  gdiffmenu'^ .  lothresh.  value) ; 
addtotablist  ( 'diffmenu^ ,  §diffmenu''  .hithresh.  value) ; 
addtotablist  ( 'diffmenu' ,  idiffmem''  .Dif fMode.buttxsnarray [1] ) ; 
addtxrtablist  ( 'diffinenu' ,  gdiffmenu''  .DiffMode.lxitdxjnarray[2] ) ; 
addtotablist { 'diffmenu' , ediffmenu'' .DiffMode.buttonarray[3] ) ; 
addtotablist  ( 'diffroenu^ ,  gdiffroenu'"  .Accept) ; 
addtotablist  ( 'diffmenu'  ,h) ; 
addtotablist('diffmenu',q) ; 

cxeatecontext  ( 'listmenu' ) ; 
addtocontext('listinenu',listmenu) ; 
addtocontext(  'listmenu'  ,h)  ; 
addtocontext('listroenu',q) ; 

addtotablist  ( '  listmenu ' ,  glistmenu-' .  DirectoryMaskButton) ; 

FOR  initindex  :«  1  TO  maxlistsize  00 

addtotablist(^listinenu' ,@listmenu^.dij  actorylist.buttonariay[ind.tindex] ) ; 
addtotablist  ('listmenu',@listmenu^.VBar.Lp)  ; 
addtotablist ('listroenu',@listmenu''.VBar.Dcwn) ; 
addtotablist  ( '  listirenu ' ,  @listmenu^ .  ViewBucton) ; 
addtotablist  ( 'listmenu' ,  glistnenu^ .  loadBucton) ; 
addtotablist  ( 'listaenu'  ,h) ; 
addtotablist ('listmenu'^q) ; 

c2:©atecxaTtext('ri^tlistinenu') ; 
addtocontext  ( 'rightlistaenu' ,  ri^tlistmenu) ; 
addtocontext( 'rightlistmenu' ,h) ; 
addtocontaxt(  'rightlistmenu'  ,q)  ? 

addtotablist ( 'rightlistmenu' ,  grigiitlistinenu''  .DirectoryMaskButton)  ; 
rOR  initindex  :»  1  TO  maxlistsize  DO 

addtotablist  ( '  ri^tlistmenu  • ,  gri^tlisanenu^ .  directorylist .  buttonarray  [  initindex  ] ) ; 
addtotablist { 'rightlistmenu' ,  grightlistmenu"'  .VBar.Up) ; 
addtotablist  ( '  rl^tlistmenu' ,  grightlistmenu'' .  VBar .  Dcwn) ; 
addtotablist  ( 'ri^tlistmenu' ,  grightlistmenu''  .ViewButton) ; 
addtotablist  ( 'ri<^tlistmenu' ,  grightlistnenu''  .LcadButtcn) ; 
addtotablist(  'ri^tlistnenu'  ,h)  ; 
addtotablist  ( '  rightlistmenu' ,  q) ; 

cxeatecontext  ( 'reliabilitylistmenu' ) ; 

addtocontext  ( '  reliability listmenu' ,  reliabilitylistmenu)  ? 

addtocontext  ( 'reliabilitylistmenu'  ,h) ; 

addtocontext  ( ' reliabilitylistmenu' ,  q) ; 

addtotablist  ( '  reliabilitylistmenu ' ,  greliabilitylistmenu' .  DirectoryMaskButton)  ; 
rOR  initindex  :=  1  TO  maxlistsize  EX) 

addtotablist  ( 'reliabilirylistmenu' ,  greliabilitylistrenu'  .directorylist.  buttonarray  r 
addtotablist ( 'reliabilitylistmenu' ,  greliabiiitylistmenu''  .''TBar.l^) ; 
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addtotablist('reliabilitylistmenu',§reiiabilirylistmenu''.VBar.Dciwn)  ; 
addt:ot2±)list('reliabili1:ylistmenu',§rieliabilitylist3nenu''.ViewButton) ; 
acJdtotablist  ( '  reliabilitylistmenu' ,  @rHliabilitylistanenu^ .  LoadButton) ; 
addtXJtablist  ( '  reliabilitylistmenu ' ,  h) ; 
addtotablist  ( '  reliabilitylistmenu  *,q); 

createcaantext  ( '  auxreliabilitylistmenu ' ) ; 

addta3C3ntexc(  'auxreliabilitylistmenu' , auxreliabilitylistmenu) ; 
aciJtcxxntext  ( 'aiixreliabilitylistmenu'  ,h) ; 
addtocontext  ( '  auxreliabilitylistmenu ' ,  q) ; 

addtotablist ( 'auxreliabilitylistmenu' ,  §auxreliabilitylistmenu'' .  DirectoryMaskButton)  ; 

FCR  initindex  :=  1  TO  maxlistsize  DO 

addtotablist  ( '  auxreliabilitylistmenu ' ,  @auxreliabililYlistmenu'' .  directorylist .  buttonarr 
addtotablist  ( '  auxreliabilitylistmenu ' ,  @auxreliabilitylistmenu^ .  VBar .  Up)  ; 
addtotablist  ( '  auxreliabilitylistmenu ' ,  ^auxreliabilitylistmenu'' .  VBar .  Down) ; 
addtotablist ( 'auxreliabilitylistmenu' , @auxreliabilitylistroenu'' . ViewButton) ; 
addtotablist ( 'auxreliabilitylistmenu' , @auxreliabilitylistmenu'' .LoadButton)  ; 
addtotablist  ( 'auxreliabilitylistmenu'  ,h)  ; 
addtotablist  ( 'auxreliabilitylistmenu'  ,q)  ; 

createcxxTtext  ( 'weightslistmenu' ) ; 
addtocontext  ( 'weightslistme.Tu'  ,weightslistmenu) ; 
addtocontext  ( 'weigiitslistmenu'  ,h) ; 
addtocontext(  'wei^tslistmenu'  ,q)  ; 

addtotablist  ( 'weightslistmenu' ,  @wei<^tslistmenu^ .  DirectoryMaskButton) ; 

FOR  initindex  ;*  1  TO  maxlistsize  DO 

addtotablist  ( 'weicjitslistmenu' ,  @wei0tslistmenu^  .directorylist.  buttonarray[  initindex) ) 
addtotablist  ( 'weightslistmenu' ,  @weightslistmenu''  .VEar.Up)  ; 
addtotablist  ( ' wei^tslistmenu ' ,  ©weightslistmenu^ .  VBar.  Down) ; 
addtotablist  ( 'weightslistmenu' ,  ©weightslistmenu^  .ViewButton) ; 
addtotablist ( 'weightslistnenu' ,  ©wei^rslistinenu^ .LoadButton) ; 
addtotablist ( 'weightslistmenu'  ,h)  ; 
addtotablist  ( 'weightslistmenu ' ,  q) ; 

cxreateoontext('wei^tscreen') ; 
addtocontext  ( '  weightscreen ' ,  basescresn2 ) ; 
addtocontext(  'vei(*tscreen'  ,h)  ; 
addtocontext  ( 'weightscreen ' ,  q) ; 
addtocontext  ( '’weigntscreen' ,  o)  ; 
addtocontext ( 'weightscreen' ,  r) ; 
addtocontext ( 'weightscreen'  ,WeightCallGrid) ; 
addtocontext ( 'weightscreen' , BIQnap2 ) ; 
addtotablist(  'weightscreen'  ,h) ; 
addtotablist  ( ' wei(^.tscreen ' ,  q) ; 
addtotablist ( 'weightscreen' , o) ; 
addtotabiist(  'weigntscreen'  ,r) ; 

createcontext  ( 'diff screen' )  ; 
addtoccntaxt(  'diffscreen'  ,basescreen2) ; 
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addtixxxitexfc'(  'diSfkxreen'*,h)  •; 
acadtxxxntext('diffscreen^q)  ; 
ad3txxxntext(^diffscxeen^,dr) ; 
addtoccntextC  'diffscxeen^  ,difference2) ; 
adcJtuxxjritejct ( 'diffsca?een^ ,  leftlowerstatus) ; 
ad3t»2OTt:ext('diffscxeen',rightlcwerstatxis)  ; 
adtoxxntext  ( 'diffscxeen^ ,  leftsidestatus)  ; 
adcttoconcext(  'diffscxeen'  ,riG^itsidestatus) ; 
addtoaaitext ( ^diffscreen^  ,DiffCellGrid) ; 
addtX)context(^diffscreenSBIGnBp2) ; 
addtx(tablist('diffsca:een',h) ; 
addtxrtablist  ( 'dif fsareen' ,  q) ; 
addtxcablist(  'diff screen'  ,dr)  ; 
addtcftablist(  'diffscreen'  ,difference2) ; 

createcontext  ( '  coveragescreen  * )  ; 
addtoccntext ( 'coveragescreen'  ,basescreen2) ; 
addtocontext( 'coveragescreen'  ,h) ; 
addtocxDntext( 'coveragescreen'  ,q) ; 
addtocontext  ( '  coveragescreen' ,  cr) ; 
addtocontext  ( '  coveragescreen ' ,  CoverageCellGrid) ; 
addtocontext  ( ' coveragescreen' ,  BIGnap2 ) ; 
addtotablist(  'coveragescreen'  ,h) ; 
addtocablist  ( ' coveragescreen' ,  q) ; 
addtotablist  ( ' coveragescreen' ,  cr) ; 

createcontext ( '  cptionsmenu' ) ; 
addtocontext(  'cptionsnienu' ,  cptionsmenu) ; 
addtocontext(  'cptionsmenu'  ,h) ; 
addtocontext  ( 'qjtionsroenu' ,  q) ; 

addtotablist(  'cptionsmenu' ,  @optionsmenu^  .buttonarray[l] ) ; 
addtotablist(  'cptionsmenu' ,  @optionsmenu''  .tuttonarray[2  j ) ; 
addtotablist ( 'cptionsmenu', @cptionsmenu''.buttonarray[3]) ; 
addtotablist ( 'cptionsmenu' ,  @cptionsmenu^  .buttonarray[4] ) ; 
addtotablist ( 'cptionsmenu'  ,h) ; 
addtotablist  ( 'cpcionsmenu' ,  q) ; 

createcontext  ( 'weightsavemenuwindcw') ; 

addtocontext  ( 'weigbtsavemenuwindw'  ,WeightsSaveMenuWindow) ; 
addtocontext  ( 'wei^tsavemenuwindcw'  ,h) ; 
addtocontext  ( ' veightsavemenuwindow' ,  q)  ; 

addtotablisr  ( ''wei<^tsavemenuwindcw' ,  @weightssavemenuwindow^  .:-JemoEcx)  ; 
addtotablist  ( 'weiOTtsavemenuwindcw' ,  @weignn:ssavemenuwindc::v'' .  ?  ileBurton) 
addtotablist  ( 'veightsavemenuwindow' ,  Sweigntssavemenu'vdjndow''  .SaveSatron) 
addtotablist  ( ' weiOTrsavenenuwindcw' ,  h) ; 
addtocablist  ( '  wei(^tsavemenviwindcw' ,  q)  ; 

crearecontaxtC  'CallPcpUp' ) ; 
addtocontext  ( '  Cel  IPcpUp ' ,  CallltxUp) ; 
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a£iitocontext('CellPc{ito^,h) ; 
addtt.'xx»it:ext(^CellPspI^^  ,q) ; 
adcitotablist(  'CellBspUp^  ,h) ; 
addtotablist('CellPcpl^',q) ; 

createcxntext ( ^DiffCel  IPopUfi^ ) ; 
addtxxMntext ( ^DiffCellPcpUp^  ,DiffCellPcpC^)  ; 
addtccant:ext(  'DiffCellPcpUlp'  ,h) ; 
addtocontextl  'DiffCellPcpUJ)'  ,q) ; 
addtotablist  ( ^DiffCellPopI^^  ,h) ; 
acadtotablist  ( 'Dif f CellPcpUJ)' ,  q)  ; 

areateoontext('SubCellPqpUp') ; 
acidtoconte)ct('S?jbCellPcpUj3SSi±Cell^^  ; 
addtocontext(  ^SubCellPopCJp'  ,h) ; 
addtoccTTtext(^SubCellBgpUp^^q) ; 

FOR  initindex  :*  1  TO  8  DO 

addtX)tablist('SubCellPopl^',@si±)CellPq3Up^.Statdcm.But±onArray[irdtindex]) ; 
addfarrtablist ( ^SubCellPcpIJp^  »h)  ; 
addtotablist(^SubCeIlPcpCJfi\q) ; 

createoontext  ( '  savemenuvandw' ) ; 
adltoccsntext  ( '  savemenuwindcw^ ,  SaveMenuWindcv) ; 
addtocont:exc(  •  savemenuwindcw^  ,h) ; 
addtocxsTtext  { •  savemenuwindow' ,  q) ; 

addtotablist ( > saveanenuwindcv' ,  @saveroenufcdj)dcw''  .MemoBax) ; 
addtotablist  ( '  saveinernjwindow' ,  @savenjeni»/indow'' .  FileButton) ; 
addtotablist  ( '  savemenuwinaow^ ,  @saveanenuwindc3(»r .  SaveButton) ; 
addtotablist  ( 'savemanuwirxiow'  ,h) ; 
addtotablist  ( '  savemenuwindcw' ,  q) ; 

creatacontext ( ' auxsavemenuwindcw' ) ; 
addtocontext  ( '  auxsavemenuwindcw' , AuxSav^fenuWiridcw) ; 
aciito(»ntext(  'auxsavenienuvdjxiciw'  ,h) ; 
addtocontext  ( '  auxsavemenuwindow' ,  q) ; 

addtotablist  ( 'auxsavernanawindow' ,  @ai2xsavemenuvindow^  .MemoEox) ; 
addtotablist  ( '  auxsavenienuwindow' ,  §auxsaveinenuwinda/' .  FileButton) ; 
addtotablist  ( '  auxsavemenuwindow' ,  @auxsaveinenuwindcvr .  SaveButton) ; 
addtotablist  ( •  auxsaveroenuwindow'  ,h) ; 
addtotablist  ( '  aiixsaveroentwindow' ,  q)  7 

createcontsxt  ( '  queuemenuwiiidcv' ) ; 

addtoccntaxt  ( '  queuemenuwindcw' ,  queuesavei^snuWindow) ; 

addtocontext  ( '  queuemenuwindow' ,  h) ; 

addtocontext  ( '  queuemenuwindcw' ,  q) ; 

addtotablist  ( 'queueinenuwindcw' ,  gqueuesaveinenuwindcv''  .IfenoEox) ; 
addtotablist  ( '  queuemenuwindcw' ,  §queuesavernenuwindcw'' ,  FileButton) ; 
addtotablist  ( '  queuenvenuwindcw' ,  §queuesavemenuwirdcw'' .  saveButtcn)  ; 
addtotablist  ( 'queuenenuwindow'  ,h) ; 
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addtbt^list'{ '  queuenenufcdnicw'' ,  q) 


createcxaTtext  ( '  ai3xqiH?J3anenuwindow^ ) ; 

addtxxMntext('auxqueueinenuwirdcw',auxqueuesaveMenuWindcw) ; 
addtcxxirrtext(^au>{queuemen^  ; 

aciitocontextC'auxqueuenemwindc^  ; 

addtotablist  ( '  aiMgueuemenuwindow' ,  @aiixqueuesavemenuidniow'^  .MemoBox) ; 
adcJtcftablist  { '  aijxqueaeroenuwirxaow' ,  @auxqueuesavemenuwindow^ .  FileBiit±on) 
addtotablist  ( ‘  aijxqueuemenuwindow' ,  §auxqu©aesavemenufcdnd(3W'' .  save&acton) 
addtotablist  ( 'ataqueufimenuvdrdcw'  ,h) ; 
addtotablist  ( ' auxqueuemenuwirdow' , q) ; 


createoontext  ( 'helpmenuwindow' ) ; 
addtocontext  ( 'helprenuhandcw' ,  HelpMenuWindcw) ; 
addtocontext  ( 'helpmenuwindow^ ,  q) ; 

addtotablist  ( •'heLprjernjwindow' ,  @helpmenuwindaw^  .NextButton) ; 
addtotablist  ( 'helproenuwindow' ,  Qhelproenuwindcvr .  PrevButton) ; 
addtotablist  ( 'helpnenuwindow' ,  @helptieniiwindoh^ .  GcToButton) ; 
addtotablist  ( 'helpmenuwindcw' .  q) ; 

createcontext('sti±)0  ; 
addtcxxntext('stub',stubwindow) ; 


(* 

ma  :*  roemavail; 
str(ma, avail) ; 

Ijog_Error( 'memory  avail  =  '+avail) ; 
ma  maxavail; 
str(ma, avail)  ; 

Log_£mor('max  avail  *  '+avail) ; 

*) 


pushcontext ( 'tasescxeen' )  ; 


ShowContext; 


shw_c3xcsor(300,200) ; 

QUIT  :=  FALSE; 

repeat 

begin 

Get_Key(K£y) ; 
gec_cinrsorXY  (X,  Y)  ; 

I?  (Key  IN  _Cursor_set)  THEN 
Move_Cursor(Key,  X,  Y)  ; 

Hi  T  .itpCnnrgyr.  (X ,  V)  ; 
button  :=  get^buttons; 

IF  (button  =  left_buttan_pressed)  GR  (key  =  ENEER)  THEN 
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ActionGQntexcCXjY)  ; 

IF  (button  =  ri^tJxttton_pressed)  OR  (3cey  =  ESC)  THEN 
CancelOontext; 
if  (key  o  0)  then 

begin  (  key  has  been  pressed. . .  } 

CheckMeiiory(key) ; 

K^ActionContext(X,  Y,  key) ; 
end; 
end 

until  QUIT; 
restoreca^roode ; 
end. 
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*  * 

*  HROGRAM  NAME  -  Omega  lerformance  Assessment  * 

*  and  * 

*  Ccverage  Evaluation  * 

*  (PACE)  * 

*  Woitetation  * 

*  * 

*  UNIT  NMffi  -  PACEINTT  * 

*  * 

************************************************************************ 
*  * 

*  Ciis  program-was- prepared  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading^  Massachusetts  01867  * 

*  * 


*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  cotpatible  * 

*  under  MS-DOS  3.3  or  hi^er  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  cotpatible  graphics  adapter  and  color  * 

*  monitor.  Uiis  work  was  performed  under  contract  number  * 


»  DroS23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  *• 

*  the  Omega  Navigation  System  Center  (C^JSCEN) ,  Alexandria,  VA. 

*  * 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Hiis  file  contains  the  procedures  to  initialize  the  PACE  * 

*  cperational  environment  including  the  display  device  * 

*  initialization  and  the  internal  PACE  database  directory  * 

*  paths.  * 


**************************************************************************  j 

Unit  Pacsinit; 

Interface 

Uses  Crt,  Dos,  Gr^,  CursrObj,  QPUtil,  Tasclogo,  Erricg; 

CONST 

(330FDAIAEASE  =  'GD0P.C3DP'; 

’';ar 

HEIPPAIH, 

PACEPA2K, 

AROGYEPAIH, 

DZEAUITQRFIIE, 

WEISGSPA2K, 

DEFADIITWEIOTSFIIE , 
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EMABASEPA3H-, 

DATABASElOa, 

DAXABASElSe, 

CCNEEXTFILE, 

HEIPFILi:  :  STRING; 


lirplerDentation 

const 

InitFileName  =  'INITPACE.TXr'  ; 

^  ***★***★*********>»*'****•**********★******************★******★***★***********  j 

procedure  ReadInitFile; 

{ 


*  * 

*  PORPOSE  * 

*  Initialization  roitine  to  read  the  PACE  setup  file  and  * 

*  assign  the  c^rqpriate  directory  paths  to  the  PACE  * 

*  internal  variables.  * 


***************************************************************************** 

) 


var 

F  ;  text; 
trp  :  string; 

begin 

HELPPAIH  :=  ' ' ; 

PACEPAIH  :=  ' '  ; 

ARCHIVEPAIH  ;= 

QRPAIH  := 

WEISnSPAIH  :=  ' '  ; 

DMAEftSEPAIK  :=  " 

nEEMJIIIQRFIIE  ;=  " 

DEFAUIirVJEIQnSFIIE  :=  • ' 

DftlABftSElOG 

DA3ABASE136  :=  >•] 

CCNTEXTFIIE  :=  ^ '  ; 

KELPFILE  ;=  "  ; 

assign  (F,  InitFileName) ; 
reset  (F) ; 

readln(F,tn!p) ; 

PACEPAIH  :=  PACEPAIH  -r  trp;  (*  read  the  drive  letter  *) 

readln(F,trp) ; 
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PAGEPAIH-  ;=-PA(SEPAn{-+  -tap,;-  (*“get  tiie-xpath  '*) 

readLn(F,tnp) ; 

ARCHEVEPAIH  :=  ARCHIVEPAIH  +  tnp;  (*  read  the  drive  letter  *) 
rBadln(F,tBp)  ; 

ARCHIVEPAIH  :=  ARCHIVEPAIH  +  tup;  (*  get  the  path  *) 

readln(F,tnp) ; 

QRPAIH  :=  QRPAIH  +  tmp; 
readln(F,tiip)  ; 

QRPAIH  :=  QRPAIH  +  tup; 

readln(F,tnp) ; 

WEIGHISPAIH  :*  WEIGHISPAIH  +  tnp;  (*  read  the  drive  letter  *) 
readln(F,tiip) ; 

WEIGHISPAIH  :=  WEIGHISPAIH  +  tnp;  (*  get  the  path  *) 
readln(F,titp) ; 

DAIABASEPAIH  :=  DAIABASEPAIH  +  titp;  (*  read  the  drive  letter  *) 
readln(F,t3ip) ; 

DAIABASEPAIH  :=  DAIABASEPAIH  +  tnp;  {*  get  the  path  *) 
readln(F,tnp) ; 

HEIPPAIH  :«  HELPPAIH  +  tnp;  (*  read  the  drive  letter  *) 
readln(F,tnp) ; 

HELPPAIH  :=  HELPPAIH  +  tnp;  (*  get  the  path  *) 

readln(F,DEEAimraRFrLE)  ; 
readln(F,DEEAIILIWEIGHI5FILE)  ; 
readln(F,DAIABASE102) ; 
readln(F,DAIABASE136) ; 
readln(F,CONrEXrFrLE)  ; 
readln(F,HELPFIEE)  ; 
close (F) ; 
end; 

^*x**'j<r*'**»*'*  ■)»***•*»*■*  »t*******'**'**'*******»t'*?»****************************»**'***^ 

procedure  Pacelnitialization; 

{ 

*******  ★*****'*^^*9ir^iF**:fc*Vr*******w*********x**xic****:^fx***********it7t-x*'W‘jif**'5t 
*  * 

*  FuPPCSE 

*  Ini'oiaiizarion  routine  to  set  ip  the  Graphics  device  driver* 

*  and  check  for  the  exiscance  of  the  various  PACE  directories’^ 

} 

var 


(*  read  the  drive  letter  *) 
(*  get  the  path  *) 
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Dirinfo 

;  SearchPec; 

ClirrentDrive 

:  string[3]; 

Driverstring, 

CurrentPath, 

errorstring 

:  string; 

PacelnitProblem 

:  boolean; 

ToftalDiskSpace, 

FreeOiskSpace, 

ver 

;  longint; 

key, 

button, 

GraphDriver, 

GrajbMode 

;  integer; 

(*  as-. defined' -in  the>DOS  UNIT  *) 


begin 

PacelnitProblem  :=  EMSE; 


clrscr; 

wrlteln; 

wirifeln ( ^ /***♦******************* /*)  j 
writeln(V  PJO:  INimilzmOJ  /'); 
writeln(  '/*************’»***■******/ ^) ; 
writeln; 

ver  DosVersion; 

writeln('DCS  Version;  ',Lo(vBr) /. ',Hi(Ver)) ;  writeln; 

GetDir  ( 0 ,  CurrentPath) ; 

CurrentDrive  ;*  CurrentPath; 

{  0  indicates  the  default  drive  } 

TotalDiskSpacx  :*  DiskSi2e(0) ; 

FreePiskSpace  Dis3cFree(0) ; 

writeln (CurrentDrivef'  is  ',TotalDiskSpace, '  bytes  in  size').*  writeln; 
writeln (CurrentDrivef'  has  ' ,  FreeDiskSpace, '  bytes  of  available  disk  space') 


Detec±GraFh(GraphDriver,6rE^phMode) ; 
case  GraphDriver  of 


CGA 

Driverstring 

=  'OGA'; 

MCGA 

Driverstring 

*  'MCGA'; 

EGA 

Driverstring 

=  'EGA'; 

SGA64 

Driverstring 

=  'SGA64'; 

EGftMcno 

Driverstring 

=  'EGAMono'; 

IH4B514 

Driverstring 

=  'IB18514'; 

HercMono 

Driverstring 

=  'Hercftono'; 

ATr400 

Driverstring 

-  'ATr400'; 

VGA 

Driverstring 

=  'VGA'; 

PC3270 

Driverstring 

=  'PC3270'; 

else 

begin 


be^; 

Driverstring  :=  '<«  Unknown  »>'; 
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;  writeln 
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end;# 

end; 

writeln(DriverStriiig  +  '  graphics  hardware  detected') ;  writeln; 


findfirst(IiiitFil^fame,  AnyFile,  Dirinfo) ; 

if  (DoSError  o  0)  then 

begin 

errorstring  :=  'File  not  found. ..«'+InitFileNaine+-'»'; 

writeln  ( errorstring)- ; 

I^celnitPrcblem 

end; 


if  ix3t(PaceInitPrbblm)  then'-begin 
ReadInitFile; 

findfirstCARCHIVHPAIH,  Directory,  Dirinfo) ; 

if  (DosError  o  0)  then 

begin 

errorstring  'Path  not  found. ..«'+ARC3ir7EPA3iff'»'; 
writeln  ( errorstring) ; 

PacelnitProblem  :=  TRUE; 
end; 


findfirst(QRPAIH,  Directory,  Dirinfo) ; 

if  (DosError  o  0)  then 

begin 

errorstring  :*  'Path  not  found.. .«'+QRPAIHf'»' ; 
writeln  (errorstring) ; 

PacelnitPrcblera  :=  TRUE; 
end; 


findfirst(^'7EIC2I[5PATH,  Directory,  Dirinfo) ; 

if  (DosError  o  0)  then 

begin 

errorstring  :•=  'Path  not  found... <<'-^vEIQ?ISPAIfrr'>>'; 
writeln  (errorstring) ; 

PacelnitProblem  :=  TFUE; 
end; 


findfirst(nAIABASEPAIH,  Directory,  Dirinfo) ; 

if  (DosError  o  0)  then 

begin 

errorstring  ;=  'Path  not  found. ..<<' T-DAIAEASZPAIHr 
writeln  ( errorstring) ; 

PacelnitProblem  ;=  TRUE; 
end; 


findfirst(HEIPPAIH,  Directory,  Dirinfo); 
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if  (DosEcror  o  0)  then 
begin 

errorstiing  :=  'Path  not  found. .  .<<'4HEIfPAlIP-'>>' ; 
writeln  (errorstring) ; 

KicelnitProblem  :=  TRUE; 
end; 


fiiidfirst(QRPAI»^'\'+DEIAUIir^^  ,Anyfile,  Dirinfo)  ; 

if  (DosError  o  0)  then 

begin 

errorstring  :=  'File  not  found. .  .<<'4<2RPjmH-'\'+DEFRDLI(3RFI^ 
writeln  (errorstring) ; 

PacelnitProblem  :=  IPUE; 
end; 


firdfirst(mai!SPiffif^'\'+DEFMJnrWEIS^  Anyfile,  Dirinfo); 

if  (DosError  o  0)  then 

begin 

errorstrirg  :=  'File  not  found...<<'+^CI(3BSPAIK+'\'+DEEAI3IIIVEEQiTSFIIE-f'>>' ; 
writeln  ( errorstring)  ; 

PaceInitPn±)lem  :=  TRUE; 
end; 


findfirst(nAIABASEPiffi^^'\'+nATABASE^  Anyfile,  Dirinfo); 

if  (DosError  o  0)  then 

begin 

errorstring  :=  'File  not  found. ..«'+DATABASEPAlH+'\'+DAIABASE102+'»'; 
writeln  (errorstring) ; 

PacelnitProblem  :=  TRUE; 
end; 


findfirst(nAIABASEPAlIif'\'+CATABASE136,  Anyfile,  Dirinfo)  ; 

if  (DosError  o  0)  then 

begin 

errorstring  :=  'File  not  found. ..«'+DAIABASEPA!IH+'\'~DAIAB?'SE136+'»' ; 
writeln  (errorstring) ; 

PacelnitProblem  :=  TRUE; 
end; 

findfirst(KEIPPAISf'\'^CCNI^^  Anyfile,  DirLnfo) ; 

if  (DosError  o  O)  then 

begin 

errorstring  :=  'File  net  found. .  .<<'-rHEIPPAIK^'\'-KX)NIEXIFIIZ-r'>>' ; 
writeln ( errorstring) ; 

PacelnitProblem  :=  IKJE; 
end; 
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fandfixst(HEp!Piffii««\'-«3E3^^  Anj^ile,  Dirinfo)"; 

if  (DosError  o  0)  thei- 

begin 

errorstring  :=  'File  not  found. .  .<<'-+ffiIiPPA3Sf'\'-Hi£LPFiiE+'>>' ; 
writeln  (errorstring) ; 

I^cfilnitPrcblem  :=  TSIIE; 
end; 

findfirst('EGAVGA.BGI',  Anyfile,  Dirinfo); 

if  (DosError  o  0)  then 

begin 

errorstring  :*  'File  not  found. ..«EGAVGA.BGI»'; 
writeln(errorstring) ; 

PacelnitProblem  :=  TE^; 
end; 


findfirst('C3ai)_10.DEF',  Anyfile,  Dirinfo); 

if  (DosError  o  o)  then 

begin 

errorstring  :=  'File  iKt  found. ..«GRID_10.DEF»'; 
writeln  (errorstring) ; 

PacelnitProblem  :*  TPDE; 
end; 


findfirst('IZIT.CHR',  Anyfile,  Dirinfo); 

if  (DosError  o  0)  then 

begin 

errorstring  :*  'File  not  found. ..«LITr.CHR»'; 
writeln  (errorstring) ; 

PacelnitPrcclem  :»  TRJE; 
end; 

findfirst(IDGOFIIZ,  Anyfile,  Dirinfo); 

if  (DosError  o  O)  then 

begin 

errorstring  :*  'File  not  found. ..«'+KX30FILE+'»'; 
writeln  (errorstring)  ; 

PacelnitProblem  ;=  TOTE; 

end; 


findfirst('W2RLD..^3AP',  Anyfile,  Dirinfo); 

if  (DosError  o  0)  then 

begin 

errorstring  :=  'File  not  fourd. ..<<WDRID.JffiP>>'; 
writeln  (errorstring) ; 

PacelnitPrcfalem  :=  TOTE; 
end; 


f indf irst  ( '  GDOP .  GDP ' ,  Anyfile ,  Dirinfo)  ; 
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if  (DosError  o  0)  then 
begin 


:=  'File  not  found. .  .«c3D0P.C3DP»'i 
writeln(ertorstring) ; 


RioelnitPrcblem  :=  TRUE; 


end; 


findfiist('TRIP.CHR',  Aryfile,  Dirinfo) ; 

if  (DosError  o  0)  then- 

begin 

errorstring  ;=  'File-^not  found. .  .«TRIP.CHR»' ; 
writeln  (errorstring)  ; 

PaoelnitPrqblera  :=  TRUE; 
end; 


findfirst('TasCLC>GO.VEC',  Anyfile,  Dirinfo); 

if  (DosError  o  0)  then 

begin 

errorstring  ;=  'File  not  fourxi. .  .<<TASCL£iGO.VEC>>' 
writeln  ( errorstring) ; 

PacelnitProblem  ;=  TRUE; 
end; 


end; 


if  PacelnitPrrjolem  then 
begin 

writeln ( '/**************************«******* / ' ) ; 

writeln('/  PROBLEM  IN  PACE  INITIALIZmON  /'); 

writelji  ( ' /********************************** / ' ) ; 

writeln; 

be^; 

halt(O) ; 

(* 

end 

else 

begin 

writeln  ( ' /****ii(************************* / ' ) ; 
writeln('/  END  OF  PACE  INimilZATION  /'); 
writeln  ( '/***'***'*********'************5t'**/^) ; 
writeln; 

*) 

end; 

writeln ('  <?ress  any  key  to  Continue>') ; 

repeat 

burton  ;=  ger_burtons; 
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GeWcey;(']o^) ; 

lOTtil  (3c^  o  0)  or  (button -=  left_button__pressed)  or 
(button  *  ri^tJxitton_pressed)  ; 


*) 

end; 


begin 

Pacelnitialization ; 
end. 
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^  ****★*•****★*******************★******★■****************■************'***** 


*  * 

*  I55CX3WM  NftME  -  Omega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  workstation  * 

*  * 

*  UNIT  NAME  -  PACBOBJS  * 

*  * 

**************************************************************-********** 
*  * 

*  Ihis  program  was  pr^jared  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  compatible  * 

*  under  MS-DOS  3.3  or  hi^ier  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  compatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  uixier  contract  number  * 

*  nrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Onega  Navigation  System  Center  (CNSCEN) ,  Alexandria,  VA.  * 

■*  * 

*  * 

*  PURPOSE  * 

*  This  unit  contains  the  declatation  and  methods  for  all  of  * 

*  the  objects  used  within  PACE.  The  declarations  for  the  * 

*  objects  vrtiose  methods  are  contained  herein  are  found  in  * 

*  the  defs.pas  program  file.  * 


************************************************************************ j 

{$N+,E+) 

UNIT  PaceObjs; 

Interface 

Uses  CRT,  Dos,  Gr^,ErrL3g,  Controls,  ConMan, 

cursrcb j ,  Cellutil ,  WorldMap ,  Paceinit ,  datautil ,  QRutil ; 

procedure  checkmemory(key;  integer) ; 

{$I  defs.pas) 

TYPE 

OiLPtr  =  "OiL;  (*  Context  Help  List  *) 

CKL  =  Record 

Next  :  CHLPtr; 
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Conte3±StX} 

filename 

end; 

HELPtx  =  ^HFL; 

HEL  =  Recxard 

Next,Prev 

filename 

end; 


:  shortstring; 

(*  Help  File  List  *) 

:  HFLPtr; 

:  shortstring; 


VAR 

ContextHelpList  :  CHLPtr; 
HelpFilesList  :  HFLPtr; 

Inplementation 


{$!  c±ieckmem.pas} 


CONST 

stations:  array[0..7,0..1]  of  integer  = 
((6642,1313), 

(630,-1066), 

(2140,-15783) , 

(4637,-9834), 

(-2097,5529) , 

(-4305,-6519), 

(-3848,14694), 

(3461,12945)) ; 


VAR 


savet^raits;  saveaieramsrecorxinir; 
rightexpanded;  boolean; 
currenteditcontext:  shortstring; 

LastLatLonX,  LastlatLonY:  Integer; 

procedure  jingle; 

{ 

*  * 

*  HJRPCSE  * 

*  Utility’  roucine  -co  prcducs  a  jingle  sound  for  debugging  * 

*  pcrpcses.  * 

*'*******:lt'*iHir*'*********'******'*w»*'Slt***'*?f*'*'*'**'*'**'***'***ilt**i*r******'****w5«*»'** 

) 
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begin 

sound(lOOO) ; 
delay(50) ; 
nosound; 
sound(1500) ; 
delay(50); 
nosound; 
end; 

procedure  messagewait; 


{ 


*  PURPOSE  * 

*  Utility  routine  that  waits  for  a  user  Jceypress.  Useful!  * 

*  ^dien  waiting  for  the  x:iser  to  acknowledge  a  displayed  message 
************************************************************************ 

} 

vaR 

dumiry:  char; 
begin 
repeat 

un^  keypressed  OR  (get^buttons  o  0) ; 

IF  keypressed  THEN  dummy  :*  readlcey; 
end; 


(***************************************************************************) 


Constructor  Cell. Init (InitX, InitY, InitWidth, InitHei^, InitLat , InitLon, 

InitCellNumber;  integer; 

InitftboveColor ,  InitB^owColor ,  InitBorderColor , 
InitBorderHiliteColorrword; 

InitActionProc  ;  CellActionProcedure ; 

InitShcwPrcc  :  CellShowPrccsdure)  ; 

{ 

***************************  *************************'***********Hf*'******* 
*  * 

*  R3RPCISE  * 

*  Method  to  initialize  the  basic  10  by  10  degree  cell  object.* 

*  * 
*******»r*******'**'»t*************************iiif**'******************'****Kf'*** 

) 

begin 

Control .  Inin  ( InitX ,  InitY ,  InitWidth ,  InitHeimt ,  InitAboveColor ) ; 

AboveColor  :=  InitaboveColor; 

BelcwColor  :=  InitEelcwColor; 

Aboveihreahold  :=  TRDE; 
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Regiptir:*  False; 

Hilited  ;*  paise; 

ActionProc  ;»  InilActionProc; 

ShowProc  :*  InitShcwProc; 

CellNunber  ;*  IxiitCellNuniber; 
Wei^itjorjOoverage  :*  1; 

Pac  :«  0.0; 

Bort3erColor  :»  InitBorderOolor; 
BortierHiliteOolor  :=  InitBorderHiliteColor; 
■  lat  ;*  initlat; 

Ion  :*  initlon; 
end; 


Procedure  Cell. Hilite(X^,Ypos; word) ; 

{ 

**★**★★★*************★■**★****★**★★*•****★★****★**★***★****•**★**★*★****■**★ 

*  * 

*  PURPOSE  * 

*  Method  to  hi^ight  a  cell  in  the  cell  grid  object  used  for* 

*  all  PACE  cell  di^lays.  * 

ieitikitiiiiiiitiiitltitiiitiiiiiiiiliiiliiiitlHtiiiiiiiiitiiiiiiiHiit'kit-kititititititititii'kititititit'it'kii-kitititititit'kiiitiiitititit 

) 

begin 

Hilited  ;«  TOUE; 
hidejnirsor; 

{  Imagesize  returns  0  if  >  64K  ) 

IF  i(nagesi2e(X-2,y-2,X+WidttH-2,Y+Height+2)  o  0  IHEN 
begin 

getineBi(BitIing,iiiBgesize(X-2,Y-2,X-Width+2,y+Height+2) ) ; 
getimage(X-2 , Y-2  ,X+Widthf2 ,  Y-tHeight+2 ,  Biting^)  ; 
end 
else 
begin 

get2iiem(BitIing,iinagesize(X-2,Y-'2,X-fWidthr2,  (Y+Height+2)DIV  2) ) ; 
getimage  (X-2 ,  Y-2 ,  X+Widt.V2 ,  (Y+Height+2 )  DIV  2 ,  Bitlmg- ) ; 
getnem(AuxBitIing,inagesize(X-2,  (Y+Hei^t+2)DIV  2,X'Width+2,Y+Hei^t+2) ) ; 
getimage (X-2,  (Y4Hei^xt+2)DIV  2, X+Width+2, Y+Height+2, AuxBitlmg'^) ; 
end; 


setcolor  (EorderHi.  1  iteColor) ; 
rectangle(X,Y,X+Width,Y+Hei^r) ; 
rectangle  (X-l,Y-l,X+Widthrl,Y+Hei^t+l) ; 
rectangle  (X-2 ,  Y-2 ,  X+Width+2 ,  Y+Height+2 ) ; 
IF  region  THEN 

rectangle  (X+1,  Y+1,  X+Width-1,  Y+Keight-i)  ; 
shcw_cursor{X5cs,Ypcs)  ; 

end; 


F-210 


File  Name:  PAC2XDBJS.PAS 


Procedure  Cell.UnHilite; 

{ 

*  * 

*  HJRPOSE  * 

*  Method  to  unhighli^t  a  cell  in  the  cell  grid  object.  * 

**************1^*****************r*  *************  *************************** 

) 


var 

XX, yy  :  integer? 
begin 

HimED  :»  FALSE? 

Get_CursorXY(xx,yy) ; 

Hide^Cursor; 

{  Iroagesize  returns  0  if  >  64K  ) 

IF  inagesize(X“2,Y“2,X+Widthf2,Y+Height+2)  o  0  THEN 
begin 

putimage  (X-2 ,  y-2 ,  Bitinsg'" ,  CcjjyPut ) ; 

freeinem(BitIing,iJiagesi3e(X-2,Y-2,X4Widthf2,Y+Height+2) ) ; 
end 
else 
begin 

putimage  (X-2 ,  Y-2 ,  Eitlmg'^ ,  CcpyPut)  ? 
putimage  (X-2,  (Y+Height+2)DIV  2,ALixBitImg'',CopyPut)  ? 
freemam  (Bitlmg,  iroagesize  (X-2 ,  Y-2 ,  X-fWidth+2 ,  ( Y+Height+2 )  DIV  2 ) )  ? 
freemem(AuxBitIng,imagesize(X-2,  (Y+Height+2) DIV  2, X+Width+2, Y+Height+2 ) ) ; 
end; 

Shcw_Cursor(xx,yy) ; 

end; 


Procedure  Cell.Shw; 

{ 

*★■**■***★**★*★***★★★*■*  ■★'^t***************'*****************'***************** 


*  * 

*  HJRFCSE  * 

*  Method  that  causes  a  cell  to  display  itself  by  calling  * 

*  the  cbjeots  display  process.  * 


**********'*****'***-ir*'*********'****'»t*****'***'**********ilt****'*x********ilr'**** 

} 

begin 

ShwPrcc(§self) ; 
end; 

Procedure  Cell.ShcwPegicn; 

{ 
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* 


★ 


*  HJRPOSE  * 

*  Method  that  draws  a  colored  border  arouxTd  any  cells  that  * 

*  are  part  of  a  user  defined  region.  * 


} 

var  XX, yy  :  integer; 
begin 

Get_CursorX5f(xx,yy) ; 

Hidejrursor; 
setcolor  (li^atcyan) ; 

{  rBctangle(x,y,»tvidth,yHfei0t) ; } 

rectangle(X+l,y+l,X+Width-l,y4fleight-l)  ; 
Show_Cursor(xx,yy) ; 
end; 


Procedure  Cell.HidePegion; 

{ 

★★★*******'******^k<Mlf********************iHlt****ilr************'************** 


★  ★ 

*  PURPOSE  * 

*  Method  that  removes  the  colored  border  around  any  cells  * 

*  that  are  part  of  a  user  defined  region.  * 


************************************************************************* 

) 

var  XX, yy  :  integer; 
begin 

Get_CursorXy (xx,  yy) ; 

Hide__Cursor; 

{  setcolor(borderoolor) ; 

r©ctangle(x,y,x+width,y+Hei^t) ;} 
setcolor( abovecolor) ; 
rectai^le(X+l,y+l,X+Width-l,y+Height-l)  ; 

Shcw_Cursor(xx,yy) ; 
end; 

Function  Cell.IsAboveIhreshold  ;  boolean; 

{ 


it  * 

*  HJRPOSE  * 

*  Utility  faction  to  have  a  cell  csaeck  itself  against  the  * 

*  user  selected  threshold.  * 


*********x*'*******************'*'***'********it******************'*******'**ie* 

} 

begin 

IsAboveShreshold  :=  AboveOireshold; 
end; 
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Function  Cell. Action (XJX3s,Ypos:vjDrd)  :i!oolean; 

{ 


*  * 

*  HIRPOSE  * 

*  Method  to  have  the  cell  perform  it's  defined  action  vAien  * 

*  the  user  elides  within  it's  boundary.  * 


***********»t*^********************************************************* 

} 

begin 

IF  Control  .Action  (^^X3s  >Ypos)  THEN  begin 
action  ;*  TRUE; 

(*  Hilite(Xpos,Ypos) ;  *) 

ActionProc(§self ,  cellnumber) ; 
end 
EI£E 

action  :=  FALSE; 

end; 


Procedure  Cell. Cancel; 

{ 

itieitifititititititititififititititititititititifititititirkitititititititifitie'kititititititititificik'kitit'kiticititititititieiticicititic 


★  * 

*  PORPOSE  * 

*  Method  to  reraove  a  cell  fran  the  cell  grid  di^lay.  * 

*  * 


) 

begin 

UhHilite; 

end; 


Constructor  CellGrid.  Init (InitX,  InitY,  Initwidth,  InitHeight  :  integer; 

InitActionProc  ;  CellActionProcedure; 


InitShcwProc  ;  CellShcwProcadure; 
InitCancelProc  ;  CellQridCancelProc ; 


{ 


initabovecolor,  initbelcwcolor,  initbordercolor , 
inithilitecolor:  integer) ; 


***★*******■*■**********★*★★*■***■****★**•*★******★***★★*★********■*********** 


* 


* 


*  H3RPCSE  * 

*  Method  to  initialize  the  cell  grid  that  is  used  for  all  * 

*  PACE  cell  grid  displays.  Contains  444  cell  objects.  * 

*:«r*:»c****'3t*********************il'**»*****7Hir***ii[**'*******it**********x*****'* 

) 


VAR 
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i,  xl,  yl,  x2,'  y2,'  xwidthv..yiiei^it,,  taiploc..:  Int^er; 
tenpl,  tarp2  :  xypt; 

tnplst;  oell_defn_ptr; 
initlc3n,initlat;  integer; 

begin 

CancelProcedure  ;=  InitCancelPnx;; 

C3ontrol . Init (InitX,  InitY,  InitWidth,  InitHei^t,  bladk) ; 

CenterX  :*  InitX  +  (InitWidth  DIV  2)  ; 

CenterY  ;=  InitY  +  (initHei^t  DIV  2) ; 

ZoonEactor  ;«  640  /  InitWidth; 
taipl  ;*  Ms^jCenter; 

MapjCenter.x  :*  CenterX;’. 

MapjCenter.y  ;=  CenterY; 

tenpZ  :*  ScaleJFactor; 

Scale__Factor.x  :*  Pound (Scale_Factor.x  *  ZocanFactor) ; 

Scale__Fac±or.y  :*  Pound (ScaleJFactor.y  *  ZcxjnFac±or) ; 
i  :=  1; 

tnplst  ;=  Cell_lst; 

WHUZ  tarplst  o  NIL  DO  begin 

Convert_tojScrBen_Position(  tnplst''. lonl,  tnplst^, latl,  xl,  yl) ; 
Convert jxi_Scr0en_Position(  tnplst^. lon2, tnplst''. Iat2,  x2,  y2) ; 
xwidth  :»  abs(x2  -  xl) ; 
yheight  :*  abs(y2  -  yl) ; 

IF  xl  >  X2  IHEN 
begin 

tenploc  :*  xl; 
xl  ;»  x2; 
x2  tenploc; 
end; 

IF  yl  >  y2  IHEN 
begin 

tenplcx;  yl; 
yl  :=  y2; 
y2  tenplcc; 
end; 

convert_to_real_jx»ition(xl+ (xwidth  DIV  2),-yl  +  (yheight  DIV  2), 

initl.cin,initlat) ; 

CellArray[i] .  Init  (xl,yl,  xwidth,  yheight,  initlat,initlon, 

i,  initabovecolor,  initbelcwcolor,  initbordercolor, 
inithilitecolor, 

(*  bl\;ie, red, lighlgray, yellow,  *) 
InitActicnProc,InitShcwProc) ; 

inc(i) ; 

tnplst  :=  tsplsx:''.next; 

END; 

>Sap_Centar  :=  tsnpl; 

Scale_Factor  :=  tsnp2; 

END; 
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Procedure  CellGrid.Shcw; 
{ 


*  * 

*  PURPOSE  * 

*  Method  to  di^lay  the  basic  cell  grid  and  in  turn  to  cause  * 

*  all  cells  within  the  grid  to  display  themselfs.  * 


} 

VAR 

X}C,yy  :  integer; 
i;  integer; 
begin 

Getj0irsorXy(3O£,yy)  ; 
Hide__Cursor; 

FOR  I  ;=  1  TO  NCEUS  DO 
CellArray[i]  .Shew; 

PDR  i  ;=  1  TO  NCELLS  DO 

if  CellArray[i]  .Region  then 
CellArray[i]  .Shc«^?egion; 
Show_Cursor(xx,yy) ; 
end; 


{  *********  incliade  the  method  for  the  coverage  grid  show  *********  ) 
{$!  covgrid.pas) 


Procedure  CellGrid.Hilite(Xpos,Ypos:  word) ; 

{ 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Method  to  hi^ight  cells  in  the  cell  grid  display  as  the  * 

*  cursor  passes  over  them.  Not  used  in  operation  because  * 

*  it  is  too  inefficient.  * 

************************************************************************ 

} 

var  i:  integer; 
begin 

(*  this  ta3ces  a  WICKED  LCH;  TIME  to  update  the  screen. . .  *) 

(*  so  I  just  left  it  out  for  new...  EMA  05-27-90  *) 

(* 

for  i  :=  1  to  NCells  do 
CellArray[i]  .Kilits(:toes,Ypos) ; 

*) 

end; 
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Rihction- CellGarid. Act:ion(}(^»s> Ypjs:  ward):  boolecui; 
{ 


*  * 

*  H3RP0SE  * 

*  Methcjd  to  perform  the  gell  grid  associated  action  ly  * 

*  invoking  the  action  methods  for  the  cell  objects  that  make  * 

*  rp  the  cell  grid  object.  * 


} 

var 

dumy.:  boolean; 
i  :  integer; 
begin 

IF  Control.Action(Xpos,Ypos)  THEN 
FDR  i  :*  1  TO  NCells  DO 
dumny  :*  CellAixay[i]  .Action(3pos,Ypos) ; 

end; 


procedure  CellQrid. Cancel; 

{ 

*  * 

*  PURPOSE  * 

*  Method  to  remove  the  cell  grid  fran  the  display.  * 

*★*****★★**★*★****★***★***★******♦**★***********★**★**★**★★★★*********** 

} 

var  i,»c,yy  ;  integer; 
begin 

GetjCursorXY  (xx,  yy) ; 
for  i  ;=  1  to  NCells  do 
if  ((XX  >  CellArray[i]  .X)  and 

(XX  <  (CellArray[i].X  +  CellArray[i] .width)))  and 
((yy  >  CeLUVrrayri]  .Y)  and 

(yy  <  (CellArray(i]  .Y  +  callArray[i]  .height) ) )  then 
CancelProcedure(9CellArray[i3) ; 

end; 


Procedure  ShcwCUrrentPickC2ioice; 

{ 

*************************************************************************** 


*  * 

*  PURPOSE  * 

*  Utility  routine  to  shew  the  current  operational  mode  for  * 

*  the  weight  editor.  Cianges  the  text  info  at  the  botton  of  * 

*  the  display.  * 


************************************'**i<t**»*'*********iit'»r'»*'*w************** 

} 
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•TAR 

stl,st2:stxing; 

liegin 

IF  Wei^itCellGrid^  .pidcingwei^ts  IHEN 
begin 

stl  :=  'WEIOnS'; 
st2  :=  'PBGICNS'; 
end 
USE 
begin 

stl  :*  'RBGICNS'; 
st2  :*  'WEIa^IS^• 
end; 

settextjt:Btify(lefttext,toptext) ; 
setcolor  (Basescreen2^ .  color) ; 

outbextxy  (Wei^tCellGrid^  ,X+20,WeightCellGrid'' .  Y+Wei(^tCellGrid''  .Height+20 , 
'Currently  choosing  '+st2) ; 
setcolor  (vMte) ; 

outtextxy  (Wei^tCellGrid^  .X4-20,WeigfatCel.lGrid^  .Y+Wei^tCellQrid^  .Height+20, 
'Currently  choosing  '+stl) ; 
outtextxy  (Wei^tCellGrid^  .X+20 , 

Wei^tCellGrid^ .  Y+Wei^tCellGrid'^  .Height+10 , 

'File;  '+Wei^tCellGrid^.Weightsfile) ; 

end; 


(^**************************************■^1************************************'^ 

procedure  WeightsGrid.Shcw; 

{ 

************************************************************************ 


*  * 

*  HJPPOSE  * 

*  Method  to  display  the  wei^t  editor  cell  grid  and  also  * 

*  shew  the  current  operational  mode  of  the  wei^t  editor.  * 


************************************************************************** 

) 

begin 

CellGrid.Shcw; 

ShcwCurrentPickChoice  ; 
end; 


constructor  Map.Init(InitX,  InitY,  InitWidth,  InitKeight  :  integer; 

InitBacknrcundColor,  InitMapCutlineOolor;  word) ; 


{ 


*  * 

*  HJPPCSE  * 

*  Method  to  initialize  the  map  object.  * 

*  ★ 
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} 

begin  ■ 

(X3nt3nol.Init(InitX,  InitY,  InitWidth,  InitHei^t,  InitBadcgztxcndOolor) ; 
CenterX  :=  InitX  +  (InitWidth  DIV  2)  ; 

CenterY  InitY  +  (Initifeight  DIV  2)  ; 

ZoanFactor  :»  640  /  InitWidth; 

Ms?«utlineOolor  :*  InitM2?)CXitlineOolor; 

M2^Bad<grtxmdColor  :=  InitBackgroundColor; 
end; 

procedure  Map.Show; 

{ 

********************************************ik***************ilt*********** 


★  ★ 

*  PURPOSE  * 

*  Method  that  draws  the  map  on  the  screen  according  to  what  * 

*  is  currently  stored  in  it's  map  vertex  list.  Also  shews  * 

*  the  positions  of  the  8  Omega  stations  on  the  screen.  * 


************************************************************************ 

) 

{  this  routine  will  display  all  of  the  map  boundaries,  rivers  } 

{  ci^  markers,  etc  ,  correcting  for  zoom  level  ty  using  a  different  } 

{  me^5  for  each  zocm  level  to  minimize  run  time  cenputation  } 

VAR 

XX,  yy,  i,  xval,  yval,  oldlon  ;  Integer; 
tazpl,  tenpZ  :  ;^pt; 

tenpviewport  ;  viewporttyj;^; 

BEGIN 

hidejcursor; 

Get_CursorXY(xx,yy) ; 
tenpl  :*  McpjCenter; 

Map_Centar.x  ;*  CenterX; 

Map_Center.y  :=  CenterY; 
tamp2  Scale_Factor; 

Scale_I^ctor.x  ;=  Round (Scale_Factor.x  *  ZoanFactor) ; 

Scale_Factor.y  :=  Round (Scale_Factor.y  ’»  ZoanFactor) ; 
SetColor(McpCXitlineColor) ; 
setlinestyle  ( solidln,  0 ,  normwidth) ; 
i  ;=  1; 

oldlon  :=  Map_Points[i]  .Lon; 

VETLS  Map_Points[i3  .Dtype  o  'Z'  CO  HTIH  Map_PointsCij  CO  BEGIN 
Convert_to_Screen_Position(  Ion,  lat,  xval,  yval) ; 

CASE  Dt^'oF 

'A';  Moveto(xval,  yval); 

'B':  IF  abs(oldlon-lcn)  <  9000  THEU  {  watch  for  wremarcund  } 
Lineto{xval,  yval) 

ELSE 
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Itoveto(xval,  yval) ; 

IND; 

Inc(i) ; 

oldlcjn  :*  Ion; 

DID; 


setcolor(li^it3nagenta) ; 

KR  i  :=  0  ID  7  DO 
begin 

QDnvert_toj5cxeenJE^it^  stations[i,13,sbitions[i,0] ,  xval,  yval); 
putpixel(xval,yval,li^TtBagenta) ; 
circle(xval,yval,l) ; 
circle(xval,yval,2) ; 
end; 


le^jCenter  ;=  tenpl; 
ScaleJFcictor  :=  teitp2; 

Show_Cursor(xx,yy) ; 
END; 


Procedure  Map.HiLite(X^>Ds,ypos:wDxd) ; 

{ 

lUfkii******************************************************************** 


*  * 

*  JORPOSE  * 

*  Method  that  displays  and  updates  the  lat/lon  'odcmeter'  * 

*  in  the  upper  right  hand  comer  of  the  PACE  screen.  * 


**************************************************************************** 

) 

VAR 

lat,  Lon:  Integer; 
nstr:  String[20]; 

CXitStr  ;  String[20]; 

tenpl,  tenp2  :  ^Qpt; 

PROCEDURE  Convert  to  string(  11:  Integer) ; 

{ 


*  * 

*  HJRPOSE  * 

*  Utility  routine  to  convert  a  lat/lon  value  to  a  string  * 

*  with  the  degree  symbol  following  it.  * 


******************************************************  W******’**********'******** 

} 

VAR 

i:  Longint; 

TenpStr:  String[20] ; 

BEGIN 
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i  :=  LL  DIY  100; 
Stx(i:3,  Ustr)  ; 
i  :=  LL  -  {i*100)  ; 
i  :=  (i  *  60)  DIV  100; 
Stx(i:2,  Tenpstr); 
LLstr  LLstr  + 

END; 


BEGIN 

IF  (Ypos  >*  Y)  AND  (Ypos  <*  Y*Hfeight)  AND 
(}^  >=  X)  AND  <«  X-Width)  AND 

((X^»s  o  LastlatlonX)  CR  (Ypos  o  LastlatlonY) )  IHEN 
BEGIN 

LastlatlonX  :=  Xpos; 

LastlatlonY  ;=  Ypos; 
tenpl  ;®  Map_Center; 

Map_Center.x  :=  CenterX; 

MapjCenter.y  :*  CenterY; 
teiip2  ;*  Scale_Factor; 

Scale_Factor.x  :*  Round (Scale_Factor.x  *  ZoonFactor) ; 
Scale__Factor.y  :*  Round(Scale_Factor.y  *  ZcanFactor) ; 
ConvertJxiJ?eal_Position(:j^x3S,  Ypos,  Lon,  Lat) ; 

IF  (Lon'"<»~18000)  AND  (Lon  >»  -18000)  AND 
(lat  <=  9000)  AND  (Lat  >«  -9000)  OHEN 
begin 

Hidejoursor; 

setf illstyle  ( solidf ill ,  blue  ( *MapBac3ogroundcx>lor*) ) ; 
bar(450,7,600,18); 

SetColor(nEpoutlinecolor) ; 

IF  (lat  <  0)  IHEN 
begin 

Lat  ;=  lat  *  -1; 

Ooiwert_to_String(Lat) ; 

CXjtStr  ;»  LLstr  +  'S  ' ; 
end 
ELSE 
begin 

OQnvert_to_String(Iat) ; 

CXitStr  ;*  LLstr  +  ^N  ' ; 
end; 

IF  (Ion  <  0)  THEN 
begin 

Lon  ;=  Lon  *  -1; 

Convert_to_String(Lon) ; 

CutStr  7=  CutStr  ^  LLsrr  'W  ; 
ei^ 

ELSE 

begin 

Ccnvert_to_String(Lon) ; 
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OutStr  :=  CXJtSta:  +  Ilstr  +  'E< ; 
end; 

SetTextJustify(LeftItext,  Topdtext) ; 
0utatextxy(450,8,  OutStr); 
Shciw_airsor(3qpos,  Ypos) ; 
end; 

Ms^jCenter  :«  teapl; 

Scale_Factor  ;=  tenpS; 

END; 

END; 


{  windcxi;  and  menu  special  purpose  methods  } 
procedure  Menu. Cancel; 

{ 

********•>***************★*********************************************** 


*  * 

*  HJRPOSE  * 

*  Method  to  remove  a  generic  menu  object  from  the  display.  * 

*  ★ 


) 

begin 

HideContext; 

PopContext; 

end; 

Procedure  messageboKci3ject,changeattr(XX,YY,WW,HH,BK,TX;  integer); 

{ 

************************************lit****************************»f****** 


*  * 

*  PURPOSE  * 

*  Method  to  initialize  a  message/alert  object.  * 

*  * 


*********************************************x***********************x** 

} 

begin 

X  :=  XX; 
y  ;«  YY; 

WIEdH  :»  WW; 

HEIGHT  :=  HH; 

CDIOR  ;=  BK; 

BQRDERCDIOR  :=  TX; 
end; 

procedure  messageboxcbject.redisplaymessage(nlines,nchars; inceger;  message;  string) 

{ 

icicrkicicifititieiticiei(it:krkificrkieit'kicitikititit'k^'k‘k’k^icicic'k'kic’kikyeic*kieic’9ci('k*kitieierkrkicieicrk^’kie^''k'kic‘ki(ycitic 
•k  * 
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* 
* 
t* 

) 

VAR 

t:  eu33y[l..Max(h]iiMessageBaxliines]  OF  string; 
i,limit,J{X,YY:  integer; 
begin 

IF  nlines  >  M2«>>UnMessageRcocLines  THEN 
limit  MaxNunMessageBGOcLines 
ELSE 

limit  ;»  nlines; 

PCR  i  :*  1  TD  limit  DO 

t[i]  :*  cc|y(messagev  (i-l)*n(±ajra^fl,nchars) ; 
borderedarea .  shew ; 

SetColor(bordercolor) ; 

GetjCursorX3f(xx,yy) ; 

Hide_Cursor; 

settextjustify(leftteact,tc!ptext)  ; 

FDR  i  ;«  1  TO  limit  DO 

ciuttejctX£(X+textwidth('12')  ,Y+(texthei^t('l')+2)*(i)  ,tCi]) ; 
sliciw_Cursor(XX,YY) ; 
end; 


*  HJRPOSE  ' 

*  Method  to  re-display  the  text  in  a  message  box  that  is 

*  already  on  the  screen. 


Procedure  messagebaxDbject.displaymessage(Xpos,Ypcs, nlines, n(±ars,badccolor,textcolor;  in 

{ 

************************************************************************ 


*  * 

*  HJRPOSE  * 

*  Method  to  re-display  the  text  in  a  message  box.  * 

*  ★ 

f. 


) 

VAR 

baxwidth,boxhei^t;  integer; 
begin 

boxwidth  ;*  textwidth('l')  *  (ndars  f  4); 
bodieight  ;»  (taxtheight('l')+2)  *  (nlines  +  2); 
changeattr(J^x3s,Ypos, boxwidth, bo5dieight,backoolor,textcolor) ; 
windcw.show; 

redi^laymessage  (nlines ,  nchars ,  message) ; 
end; 


procedure  messag^xsxcbj  ect .  Iiidemessage ; 

{ 

*  * 
*  PURPOSE  * 
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*  Method  to  remove  a  message  boK- f2Xin<  the  -di^layi  * 

*  * 

) 

begin 

window.hide; 

end; 

constructor  stubcbject.init; 

{ 


*  * 

*  HJRPOSE  * 

*  Method  to  initialize  a  dummy  object.  Used  for  debug.  * 

*  * 


} 

begin 

menu.init(320-te5ctwidth('  Not  inplemented  yet. . .  *)  DIV  2, 

150, 

textwidth('  Not  inplemented  yet. . .  0,20, 

red, 

white, 

1, 

WiirbwShadcwWidth) ; 

end; 

procedure  stubobject.show; 

{ 


*  * 

*  HJRPOSE  * 

*  Method  to  display  a  dumny  object.  Used  for  debug.  * 

*  * 


) 

var 

XX,  yy;  integer; 
begin 

menu,  shew; 

s£ttextjijstify(centertaxt,centertext) ; 

get_cursor3y(xx,yy)  ; 

hide__cursor; 

outtextxyCX+width  Dr/  2,Y+hei^t  DIV  2, 'Nor  inplemented  yet...'); 
shcw_cursor(;cc,yy) ; 
jingle; 
end; 

constructor  linkedbuttcn3D.Init(InitX,InitY,InitWidth,InitHeight, 
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InitColor,~InitHilitecolor, 

InitNaneOolor ,  InitHilit^fameColor:  integer; 

InltNaine:shortstrii)g;InitAcrtdcnPrc«:Acrt:ionProc»dure;InitHcftKey ;  char) 

{ 

************************************************************************ 


*  * 

*  PODRPCSE  * 

*  Method  to  initialize  a  3D  button  that  also  has  an  action  * 

*  that  can  be  dynamically  associated  with  it.  * 


} 

begin 

actiotproc  ;*  InitActionProc; 

textbutton3d.Init(InitX,InitY,InitWidth,InitHeight,  ■ 

InitOolor ,  InitHilitecolor , 

InitNanveColor ,  InitHiliteNaroeColor, 

InitNarDe,InitHbtKey)  ; 

end; 

function  linkedburtonSD. action  (XX,  YY;wDrti)  :boolean; 

{ 

*★****★•*★★★***★****★*★**★**★  ★★'^r*-********^******************************* 


*  * 

*  HIRPOSE  * 

*  Method  to  activate  a  3D  button  that  has  an  dynamicadly  * 

*  associated  action.  * 


************************************************************************ 

) 

begin 

Action  ;«  FALSE; 

if  textbutton3d. action {XX, YY)  then 
begin 

ActionProc; 

Action  ;*  TRUE; 

end; 

end; 

constructor  linkedbutton.Init(InitX,InitY,InitWidth,InitHeight, 

InitColor ,  InitHilitecolor, 

InitNameColor ,  InitHiliteNameColor;  integer; 

InitName;  shortstring;  InitActionProc;  ActionProcedure ;  InitHotKey :  char; 

{ 


»  * 

*  PURPOSE  * 

*  Method  to  initialize  a  button  that  also  has  an  action  * 

*  that  can  be  dynamically  associated  with  it.  * 


*****'**'*'*'*'********'»t******»f*************'jt*»r*******Tt**»**x**»'»nnt**:!ic'*x*'x**w 

) 


F-224 


File  Name:  PACEOBJS.PAS 


begin 

acticafisroc  :=  IiiitActionProc; 
te3ct±ut±on.  Init  (InitX,  InitY ,  InitWidth,  InitHei^^t, 
InitColor,  InitHilitecolor , 
InitNameColor,  InitHiliteNameColor , 
Initlfeane ,  InitHotKey ) ; 

end; 


function  lin]<Bdlxrtton.  action  (XX,  YY:vrord)':lxx3le2ui 

{ 

irkiHtititit**iiiiit*it*ititiiit********itit*****************************ii*******icit**** 


*  * 

*  H3RP0GE  * 

*  Method  to  activate  a  button  that  has  -an  dynamicadly  * 

*  associated  action.  * 


************************************************************************ 

} 

begin 

Acticai  :*  FALSE; 

if  textbutton. action (XX,  YY)  then 
begin 

ActionProc; 

Action  :*  TRUE; 

end; 

end; 


{  utility  functions  to  save/restore  info  into  the  different  contexts  } 
procedure  SaveEditParaiiB(^jtr:anenuptr;  saved:  savedparanisrecordptr) ; 

{ 

*★***********★★*★********★★**★★****★*  *********************************** 
*  * 

*  FURPDSE  * 

*  Utility  to  save  the  edit  screen  parameters  so  that  we  * 

*  can  get  back  to  them  later.  * 

★★Ik********************************************************************* 


) 

VAR 

i;  integer; 
begin 

saved''. Psa  ^rtr''.Psa.Vcilue. value; 
saved^.SNR  ;=  ^Jtr'. SNR. value. value; 

saved-'. ShortLongRatio  :=  ^ncr'.ShorcIongRario.value.value; 
saved''. XAngle  :=  ^rtr^.XAngle. value. value; 
saved''. IhaseDev  :=  eptur'.HiaseDev. value. value; 
saved''. CMoff  ;=  sncr'.i:M.buttonarray[l] .selected; 
saved''. EMcn  ;=  epcr'.EM.burtonarray [2] .selected; 
saved^.Ctoicked  :=  a:?tr'. EM, picked; 

saved''. Si^&est  :=  KKcr'.StationReliabilityMcdel.buttonarrayril .selected; 
saved-'. SPMncan  :=  eptr''.StationReliabilityModel.buttonarraY[2] .selected; 
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sa[yed*'.sr®®jorst'-.  :=  epj^.SlatigtiFi^^iidti^Moaelitu^^ 
saved''. SI%ickEd  :=  eptr' .StaticgiPeliabilityModel.picted; 
saved''. Frl02  :=  eptr'.Freq.Jxtttcsnarraytl]. selects 
saved-'. Frl36  :*  eptr''.Freq.hiut±onarray[2].selec±ed; 
saved''. FeAND  :*  ejrtr^.Freq,lxittonarray[3]. selected; 
saved^.FrCR  :=  qptr'.Freq.buttonarray[4] .selected; 
saved''. Frpicked  :*  ^Jtr'.Freq.pidked; 
saved-'. aXDP  :=  QJtr'.aDOP. value. value; 

{ 

saved-'. PsaRAN  :«  eptr^.P»Calculatdiode.buttanarray[l]. selected; 
saved^.PsaEET  :«  ^Dtr'.I^calculateMcxSe.buttanarray [2]  .selected; 
saved^.PsaCalpidced  ceptr^.PsaCalculate^fede.picked; 

} 

saved-' . PsaMIN  t-neptr'  iPsaReportMbde.Jxtttcrarra  . selected; 

saved^.PsaMEAN  :*  €ptr^.PsaRf^rtMode.buttanarray[2] .selected; 
saved^.PsaMAX  :*  ^rt2r'.PsaReport[to3e.twttonarray[3]. selected; 
saved-', PsaRq^jicked  ;=  eptr'.PsaReportMode.picked; 

K3R  i  :*  1  TO  8  DO 

saved^.StationPcwerfi]  :*  eptr-'.StationPower[i]  .sld.value. value; 

K3R  i  :»  1  TO  8  DO 
begin 

saved-'. StationPcweirOnCi]  :=  eptr^.StaticanPcwerCi]  .On. Selected; 
saved-'. StationPawerOff[i]  :*  ept3r.StationPower[i]  .Off. Selected; 
end; 


FOR  i  :»  1  TO  12  DO 

saved-'. MonthSelectors[i]  :»  QJtr^.ltonthSelectors[i]  .selected;, 
FOR  i  ;»  1  TO  24  DO 

saved^.HourSelectorsCi]  ;=  ^tor'.HourSelectors[i]  .selected; 
saved^.QRFile  :*  eptr'.QRFile; 
saved^.WeightsFile  :=  eptr^.Wei^tsFile; 
end; 


prccedure  RestoreSditParams  (eptr : emeiuytr ;saved:  savedparamsrecordpar) ; 

{ 

★★A********************************************************************* 


*  * 

*  H3RP0SE  * 

*  Utility  to  read  back  the  edit  screen  parameters  that  we  * 

*  saved  with  saveeditparans.  * 


*■****★*'*•**■***★•**■******•****'***★■*******■*■»*★■****★■*»*****■***•***'**★**•*■**■***•** 


} 

VAR 

i:  integer; 
begin 

ato“'.?sa  .value. value  :=  saved^.Psa; 

^rtar'.SNR  .value. value  ;=  saved-'. SNR; 
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qptr' 

eptr^ 

eptr' 

eptr^ 

eptJT' 

eptr^ 

eptr' 

eptr^ 

eptx^ 

eptr' 

eptr' 

eptr' 


.  ShortLon^tio 

.xangle 

.HiaseDev 

.EM 

.DM 

.EM 


.value. value  :=•  saved' 

.value.value  :=  saved 

.value.valxoe  :=  saved' 

.lxrttcnarray[l]  .selected  := 
.]x»ttonarray[23  .selected 
.picked  :=  saved''. Hoicked; 


StatianReliabilityModel.buttonarxayCl]  .selected  :« 
StatlcnReliabilityModel.lxittcaiarray[2]. selected  :« 
StationReliabilityModel.tiuttcrarray[3]. selected  := 
Sta-tionReliabilityModel.picked  :=  saved''. SRt^id<Bdi 
Freq  .JxtttonarrayCl]  .selected  :* 

Freq  ,  .buttcaiarray[2]. selected  ;*■ 

Freq  .buttonarray[3]  .selected  :=• 

Freq  .tuttonarray [4], selected  := 

Freq. picked  :=  saved''. Frpicked; 


.  ShbrtXpnqte'tio ; 
.xangle; 
.PhaseDev; 
saved^  .EMoff  ; 
saved-'.  EMon; 

saved^  .SPMbest; 
saved^.SRMncm; 
saved-' .  SPMworst ; 

saved-'.  Frl02; 
saved''.Frl36; 
saved-'.  FrAND; 
saved-'.  FrOR; 


eptr-'.(3X)P  .'value.'value  :=  saved-'. GDOP; 

{ 

eptr'.PsaCalculateMDde.buttonarray[l]. selected  :*  saved^.PsaRAN; 

^rt2r'.Psacaicxaat^toie.buttxinarray[2]. selected  :®  saved-'. PsaEET; 

eptr'.PsaCsdculat^tode.picked  :*  saved^.PsaCalpicked; 

) 

eptr-'.EsaReportMode.buttonarrayCl] .selected  ;»  saved-'. PsaMIN; 
eptr'.PsaRe^xartMcde. tutted  .selected  ;=  saved-'. PsaMEAN; 

eptr-'.PsaReportMc)de.]wttcmrTay[3]  .selected  :»  saved-'. PsaMAX; 
eptr-'.PsaReportMcde.picked  :*  saved-'. PsaR^icked; 


FOR  i  :*  1  TO  8  DO 

^7tr-'.Sta'tionPcwer[i]  .sld.-value. value  :*  saved-'.StaticnPowerCi] ; 

FOR  i  :*  1  TO  8  DO 
begin 

^3tr-'.StationPcwer[i] .On.Selected  :*  saved'. StationPcwerOn[ i] ; 
^rta:-'.Static3nPcwer[i]  .Off. Selected  :=  saved-'. StationPowerOf f [ i] ; 
end; 


FOR  i  :=  1  TO  12  EO 

Q*r-'.MonthSelectors[i]. selected  ;*  saved-'. MonthSelectors [ i] ; 
FOR  i  :=  1  TO  24  DO 

eptr'.Hcxa:Selectors[i]. selected  ;=  saved''.HourSelectors[i] ; 
^±r'.QRFile  :=  saved-'. QRFile; 
epcr-'.WeightsFile  :=  saved'. WeightsFile; 
end; 


{  control  button  special  purpose  me'thcds  } 

constructor  MutExclusiveN. Init (InitX, InitY, Ini'tWidth, InitHei<^t , 
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InitGoloTj  InitHilitecolor,  initSelectedOolor-, 

IxutNaiineGolor-,  InitHiiLit^feBneCblor  >  InitSeiectedNatneGolor :  Integer; 
InitControl  label  ;shortstrii^;InitNuniberBattons^InitBattainSelected:iriteger 
But:tariNaneList:na]nearray;InitOrientatic!n:boolean) ; 

{ 


*  ★ 

*  HJRPOSE  * 

*  Initialization  routine  for  an  object  that  allows  the  * 

*  selectio  of  one  of  n  buttons.  * 


★it*********-****************************************************  ********* 

) 

var-, 

dunny;  boolean; 

i:  integer; 
begin 

XDffset  :=  5; 

yoffset  ;*  1; 

Orientation  ;=>  InitOrientation; 

NunberButtons  InitNusberButtons; 

R®  i  ;*  1  TO  NumberSuttons  DO  begin 
if  (Orientation  *  Horizontal)  then 
ButtonArray(i]  .Init(InitX+(i-l)*(lnitWidthfxoffset) , 

InitY,  InitWidth,InitHeight,  InitColor, 
InitHilitecolor,  InitSelectedOolor, 
InitNameColor, InitHiliteNameColor, 
InitSelectedNameColor ,  ButtanNamelist  [  i  ] ) 

else 

ButtonArray[i]  .Init(InitX,Inity+{i-l)*(InitHeicbt+yoffset) , 

InitWidth,  InitHeight,  InitColor, 

InitHilitecolor,  InitSelectedOolor, 
InitNameColor,  InitHiliteNameColor, 
InitSelectedNameColor ,  ButtonNameList  [  i  ] ) ; 

ersd; 

IF  InitButtonSelected  >  0  THEN 

ButtonArcay[InitButtonSelected]  .TumOn; 

Control  label  ;=  InitCcntroUabel; 

Picked  :*  InitButtonSelected; 
end; 


procedure  MutExcliisiveN.Shcw; 
{ 


*  * 

*  HJRPCSE  * 

*  ffethcd  to  display  the  murually  exclusive  set  of  selector  * 

*  bucrons.  * 


) 
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VHR 

i:integer; 

begin 

FGR  i  :=  1  TO  NunberButtons  DO 
ButtcnAn:ay[i]  .Shcv; 
if  orientation  =  horlzcntal  then  begin 
SetTextJusti^(RLc^itText,OenterTe^  ; 
SetOolor(BizttcnArray[l]  .OcntiolOolor) ; 
OutText3H(ButtcaiArray[l]  .X-5, 

ButtanArray[l].y+l+Buttonftrray[l].H^  DIV  2, 
OontroUabel) ; 
end 

else  begin 

SetTextJustiQr(Cen(terText,OenterText) ; 
SetOolor(ButtonArray[l]  .OontrolOolor) ; 
OiitTextxy(ButtonArray[l].X+ButtonArray[l]  .Width  DIV  2, 

ButtonArray[l]  .Y+l+ButtonArray[l]  .Hei^it  DIV  2, 
OontroUabel) ; 

end; 

end; 


procedure  MutExcliisiveN.Hilite (2^X36, Ypostvord) ; 

{ 

************************************************************************ 
*  * 

*  HIRPOSE  * 

*  Method  to  hi^i^t  the  mutually  exclusive  set  of  selector  * 

*  buttons.  * 

************************************************************************ 

) 

VAR 

i;  integer; 
begin 

FOR  i  ;=  1  TO  NumberButtons  DO 

ButtonArray[i]  .HiLite(J$x3s,1Qpos) ; 

end; 


procedure  MutExclusiv^.OiangeXY (3^X36, ^fposzword) ; 

{ 

************************************************************************ 
*  * 

*  RIRPOSE  * 

*  Method  to  change  the  X  Y  position  of  a  mutually  exclusive  * 

*  set  of  selector  buttons.  '* 

************************************************************************ 

} 

var 

i  ;  integer; 
begin 
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KJR  i  :=  1  TO  Numberaittons  DO 
if  Orientation  =  Horizcntal  then 
ButtcnAxxay[i]  .QiangeXSf  (}i$xis+ 

(i-l)*(ButtonArray[i]  .Widthfxoffset)  ,Ypos) 

else 


end; 


ButtonArray[i]  .ChangeXY0<^xi6,Y|x)s+ 

(i-1)  *(ButtonArray[i]  .Heigiit+yoffset) ) ; 


function  Hut£xclusiv^.Acticn(3^06,Ypo6:vrord)  :boolean; 
{ 


*  PURPOSE  ** 

*  Method  to  invoke  -the  action  ggsociated  with  a  mutually  - 

*  exclusive  set  of  selector  buttcns.  * 

**************************************************************'********** 

) 

var 

i,j:  integer; 
begin 

Action  :*  FALSE; 

PCR  i  ;»  1  TO  NumberButtons  DO 
begin 

IF  ButtonArray[i]  .Action(3{^,Ypos)  THEN 
begin 

Action  :»  miE; 

FOR  j  ;»  1  TO  NumberButtons  DO 
IF  ButtanArray[j]. selected  THEN 
ButtonArcayC  j  ]  .TumOff ; 

ButtonArrayCi]  .TumOn; 
picked  ;»  i; 
end; 
end; 
end; 


constructor  OnOf fSlideControl  •  Init  (InitX,  InitY ,  InitColor,  InitHiliteColor ,  InitSelectedColo 
InitCcntrolColor,  InitHiliteControlColor,  IzutSelectedControlColorrword; 
IxutLoLim,  InitHiLim,  Initinc;  longint ; 

InitAccel: integer ;initNanie,lnitllnits;shortstrirg) ; 

{ 

★  * 

*  H3RP0SE  * 

*  Initialization  for  a  slider  bar  control  that  can  be  turned  * 

*  on  and  off.  * 

*'*********'*********'**'****'*±*'***w*»f*'*****1»***'*llf*'jif****-******'*'>t*l*t*****»**'*n 


} 

begin 
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Off .Init (Iiiitt+HJaarvada^  , InitY, 30 ,H_bariiei^t, InitColor,  InitHiLiteColor ,  InitSeiect 
IiiitCcntrolColor,  IriitHiliteControlColor ,  IrdtSelectedControlColor , 

'Off'); 

On.  Init  (Off  .X+1+30,  InitY,  30  ,H_barheight ,  InitColor,  InitHiLiteColor,  InitSelectedColor , 
InitOontrolOolor,  InitHiliteControlColor,  InitSelectedControlColor , 

'On'); 

SID.  Init  (InitX,  InitY,  InitColcar,  InitHiLiteColor, 

InitControlColor,  InitHilii  teControlColor ,  InitLoLim,  InitHiLin, 
InitInc,InitAocel,IiiitNamB,IriitUnits,5,0) ; 

On.TumDn; 

end; 

procedure  OnOffSlideCorttrol.HiLite(Xpos,Ypos:word) ; 

{ 

it**1i***********ifk*irk**1tii*********it****ifk*****itit***************ii********* 

*  * 

*  H3PP0SE  * 

*  Highlight  method  for  slider  bar  control  that  can  be  turned  * 

*  on  and  off.  * 

************************************************************************ 

) 

begin 

Off  .HiLi  te  (Xpos ,  Ypos)  ; 

0n.HiLite(J^X3S,Ypos) ; 

IF  On.Selected  THEN 

SID. HiLite(3{pos, Ypos)  ; 

end; 


procedure  OnOffSlideControl.Shcw; 

{ 

it  * 

*  PURPOSE  * 

*  Shew  method  for  slider  bar  ccntrol  that  can  be  turned  * 

*  on  and  off.  * 

**********************************************w************** *********** 

} 

begin 

Off. Show: 

On. Shew; 

SLD.Shcw; 

IF  Off. selected  THEN 

SLD.Value.Changename('Off') ; 

end; 


function  CnOffSlideConcrol,Acd.cn(Sx:s,Ypcs:word)  :boolean; 

{ 

itititititicit-kititititieicieit'ftisiticieicitititititicieit'ft'kititit’xitit^ttitifkie'x^icyt’xitic^feyeictfk'fe-tcitierkitie^icttieieititit'yt 
*  It 
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*  HIRPGSE-?^  * 

*  Action  method  for  slider  bar  control  that  can  be  turned  * 

*  on  and  off.  * 

) 

var 

St:  shortstring; 

sldaction,  onoffactionrboolean; 
begin 

onoffActicn  :*=  FALSE; 
sldaction  :»  FALSE; 

IF  Off.Action(3$X3S,Ypos)  TOEN' 
begin 

Cn.TumOff; 

Off.TumOn; 

SID, Value. Changename( 'Off') ; 
onoffAction  :»  TEUE; 
end; 

IF  On. Action (XfX3S,Ypos)  IHEN 
begin 

On.TumOn; 

Off.TumOff; 

Str (SID. Value. Value:SID. Value. int:SID. Value,  frac,  st) ; 
SID.Valxie.Qxangename(St) ; 
onoffAction  :*  HSJE; 
end; 

IF  On.Selectad  THEN 

sldActicn  :*  SLD.Action(3^xs,Ypos) ; 

Action  :=  onof faction  OR  sldaction; 
end; 

function  SelectButton.Action()$x3s,Ypos:word)  :boolean; 

{ 


*  * 

*  HJRPCSE  * 

*  IniticLLization  for  a  set  of  buttons  where  the  user  can 

*  choose  as  many  as  desired.  * 


************************************************************************** 

} 

begin 

Action  :=  FALSE; 

IF  StatusButton.Action(]fix^,Ypcs)  TEEN 
begin 

IF  selected  IHEN 

starusbutton .  Turnoff 
Else 

Statusbutton.  Turnon ; 

Action  :=  TE5JE; 
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end; 

end; 

constructor  pid<mem.Init(Xjx»,Ypos;word;InitNunt)erButtons;integer; 
InitNameIist;Pid<MenuNaroeArray;InitActicaTs;PickMenuActionArray; 
InitHotteys;Pid<Merafflot3{eyitora^^ ; 

{ 


*  PURPOSE  * 

*  Initialization  for  a  list  object  vAiere  the  viser  can  select  * 

*  a  particular  itan  of  interest  and  also  scroll  the  list.  * 
************************************************************************ 

) 

Const 

menacoior  =  cyan; 
menubordercolor  »  black; 
buttoncolor  »  white; 
hilitecolor  »  li^tblue; 
textcolor  »  black; 
hilitetextcolor  »  vAiite; 

VAR 

i,menuheight:  integer; 
begin 

NunberButtcns  ;*  InitNumberfiuttons; 
menuheight  :»  5  +  NuittierButtons*20; 

mem.Init(3$xx, Ypos, 80, inenuheight,menucolor, menubordercolor, 2, WindowShadowWidth) ; 

FOR  i  1  TO  NumberButtcns  DO 

ButtonArray[i]  .Init(X+10,Y+4+(i-l)  *20, 60, 16, buttoncolor, hilitecolor,  textcolor,  hilit 
IratNaiieIist[i],InitActions[i],InitHotReys(;i]) ; 

end; 


function  pickmem. Action (J^»s,Ypos; word)  :boolean; 

{ 

**1i****1i**********itiiitii*iiifk**1t******it*****itifkit**ii***1iiiit****************itit 
*  * 

*  PURPOSE  * 

*  Action  method  for  a  list  deject  viiere  the  user  can  select  * 

*  a  particular  itan  of  interest  and  also  scroll  the  list.  » 

) 

var 

XX,YY,i:  integer; 
begin 

Action  ;=  5ALSE; 

FOR  i  :=  1  TO  NumberButtcns  DO 

I?  ButtonArrayfil  .acticn(^^xs,Ypcs)  IKEN 
Action  :=  TRUE; 

end; 
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futx±ic«  piclaiem.KeyActdcn(X^x»,Ypos:vrorf  ]cey:iiitager)  thjbolean; 
{ 


'Hotlcey'  method  for  list  object  viiere  the  user  can  select  * 
a  particular  item  of  interest  and  also  sd-oU  the  list.  * 


} 

var 

i:  integer; 
begin 

R^Action  :*  false; 

PGR  i  :=  1  TO  NumberButtons  DO 

IF  ButtonArray[i].]ceyaction(J5»s,Ypcs,key)  IHEN 
KeyAction  ;»  TE3JE; 

end; 


procedure  pickmenu.Shcw; 
{ 


*  Show  method  for  list  object  where  the  user  can  select  * 

*  a  particular  item  of  interest  and  also  scroll  the  list.  * 

***********itirk*****itititit*irkitirk**ii1iiiitii*it1t*iiitit1t*itit**********it***ifk****irk*iri; 


) 

VAR 

i:  integer; 
begin 

menu,  shew; 

R3l  i  ;*  1  TO  NumberButtons  DO 
ButtonAnayCi]  .Show 

end; 


procedure  picKmenu.HiLite(;^xs,Ypcs;word) ; 
{ 


*  Highli^t  method  for  list  object  wiere  the  user  can  select  * 

*  a  particular  item  of  interest  and  also  scroll  the  list.  * 
************************************************************************* 

} 

VAR 

i;  integer; 
begin 

FCR  i  :=  1  TO  NumberButtons  DO 
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ButtxnArray[i].HiLite(X^xs,Ypos)  ; 

end; 

prcx^dure  Imerai.Dispose01dDirectaryList; 

{ 


*  H3RP0SE  * 

*  ftethod  for  getting  rid  of  the  currently  displayed  list  of  * 

*  file  names  so  that- •we  can  get  and  di^lay  a  new  list.  * 


) 


var 

tnp,  ptr  :  listptr; 
begin 

tnp  :*  Didst; 
if  tnp  o  nil  then 
repeat 

prCr  :«=  tnp^.next; 
dispose  (tap) ; 
tap  ;*  per; 
intil  (ptr  *  nil)  ; 
end; 

procedure  Imsnu.DisplayDirectoryLdst; 

{ 


*  * 

*  KRPOSE  * 

*  Method  for  displaying  the  current  list  of  file  names.  * 

*  * 


) 

•var 

ptX/ tolp 
Jipos,Ypos 
begin 

per  ;=  Didst; 

^ 

if  (listpesitien  o  i)  then 
repeaz 

if  -o  nil  then  begin 

ptr  ;=  per. Next; 
inc(i) ; 


:  listptr; 
:  integer; 
:  integer; 
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end; 

until  (i  *  list^jcsition)  ; 
i;*l; 

while  (i  <*  maxlistsize)  do  begin 
if  ptr  o  nil  then  begin 
Direc±oryList.ButtcnAncay[i].N^  ;=  ptr'.IName; 
ptr  :*  ptr'. Next; 
end 
else 

DirecrtX)ryIist.ButtonArray[i].Naine  :* 
inc(i) ; 
end; 

Get_CursorX5f(3$)OS,Ypos) ; 

Hide_Cursor; 

FOR  i  ;*  1  TO  maxlistsize  DO 

IF  directorylist.buttcnarray[i]  .selected  AND 
((directorylist.huttonarray[i].naine  ^  GR 
(directorylist.huttanarray[i].naine  »  '<tcp>')  OR 
(diiBC±orylist.buttonarray[i].na]ne  «  '<bc(ttcin>') )  THEN 
begin 

directorylist.buttonarray[i]  .TumOff ; 
dixectorylist.picked  ;»  -1; 
end; 

Directorylist .  Shew; 

Shcw__Cursor(X^,ypos) ; 
end; 


procedure  Iroenu.GetNewDirectoryList; 

{ 

************************************************************************* 
*  * 

*  HJRPOSE  * 

*  Method  for  getting  a  new  list  of  file  names.  * 


*****ifk**-kit*it***ifk**’k**rK*****it****it*if*****ifit*****it*irk*rk**ifk*****it*it***** 


var 

tup, ptr  :  Listptr; 

Dirinfo  :  SeardiRec;  (*  SearchRec  is  defined  in  the  Dos  Unit  *) 

begin 

new(Dlist) ; 

Dlist^.FName  ;=  '<top>'; 

Dlist'^.Next  :=  nil; 
per  :=  Dlist; 
listlength  ;=  1; 
listposition  :=  1; 
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fiixifirst(IlFaDLIPJffii+DirECtX)ryMaskBiit:ton.TextjStrir)g>SysFile,DirInfO; ; 
while  (DosError  =  0)  do  begin 
new(tnp)  ; 

tnp^.INaroe  :=  DirInfo.Name; 
tn^y^.Next  :®  nil; 
ptr^.Next  ;«  tup; 
ptr  ;*  tnp; 

inc(listlength) ; 
findnext(Dirlnfo)  ; 
end; 

new(t3tp)  ; 

tnp^.INaroe:  ;=  '<bottan>'; 
tnp^.Next  ;=  nil; 
ptx^.Next  :=  tnp; 
ptr  :=  Dlist; 
inc(listlength) ; 

VBar.HiLim  ;=  listlength(*-roaxlistsizefl*) ; 

VBar. Value  ;=  listposition; 
end; 


Constructor  linenu.lnit(3^3cs,  Ypos  ;  word; 

InitMeTuColor,InitMenuBorderColor;  word; 
Vlink,  Ilink  :  ActionProcedure; 
InitPath,InitEString:  string) ; 

{ 


■k  * 

*  PURPOSE  * 

*  Initialization  for  an  c±>ject  that  lets  the  user  pick  a  file* 

*  name  fron  a  scrollable  list.  * 

************************************************************************ 


} 

Const 

be  =  white; 
he  =  lightblue; 
sc  *  yellow; 
tc  =  black; 
htc  =  white; 
stc  *  black; 
ems  »  18; 


{  button  color  ) 

{  hilite  color  } 

{  selected  color  } 

{  text  color  ) 

{  hilited  text  color  } 

{  selected  text  color  } 

{  edit  menu  spacing  constant  } 


var 

labelarray :  namearray ; 
i  ;  integer; 

begin 

ac  :=  InitMenuColor; 
mbc  :=  InitMenuBarderColor; 
EString  ;=  InitSString; 
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DEEADLEPMH  :=  InitPath; 


listposition  :*  1; 
listlength  :=  0; 
Dlist  :*  nil; 


menu  .Init(Xpos,  15x»,180,180,mc,ii±c,2,WirricwShadcwWidth)  ; 

DirectoryMaskButton.  Init (X+10 ,  y+6 , 160 , 15  ,hc , he , tc,htc, EString,  0,4,19,  FALSE) 


Vbar 
DirectoryList 


Viewfiutton 

loadButton 

selectedfile 

end; 


.Init(X+138,Y+27,  bc,hc,tc,htc,1.0,1.0,1.0,linearscale) ; 
.Init(X+28,  Y+27,  100,12,bc,hc,sc,tc,htc,stc, 

' '  ,inaxlistsi2e,-l, 
labelarray,vertical) ; 

.Init(X+20,  Y+159,60,16,bc,hc,tx:,htc,  'View'  ,Vlink,  'V')  ; 

. Init (X+100 ,  Y+159 ,60,16 , bc,hc, tc,htc,  'Load' , Uink,  'L' )  ; 


/  / 


procedure  Iroenu.Shcw; 

{ 

*********Tlt**Tltllt************1lt********************************************* 


*  * 

*  ropposE  * 

*  Method  for  displaying  a  list  of  scrollable  items.  * 

*  * 


************************************************************************ 

) 

begin 

menu. shew; 

DirectoryMaskButton.  Show; 

ViewButton.Shcw; 

LoadButton.Show; 

GetNewDirectoryList; 

DisplayOirectoryList  ; 

VBar.Shcw; 

end; 


procedure  lmenu.HiLite{:$x:s,Ypos:word) ; 

{ 

****************************************i<r************************'******* 


ilr  * 

*  lURPCSE  * 

*  Method  for  highlighting  a  list  of  scrollable  items.  * 

*  * 


) 

begin 

menu.HlLlteC^^xs,  Ypos) ; 
DirectoryMaskButtcn.HiLita(]Sx:s,Ypcs)  ; 
VBar .HiLite  ,  Ypes)  ; 
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DijectoryList.HiLite(]to:s,Ypcs)  ; 
Viewfii±tOT.HiLite(:^XDs,Ypcs)  ; 
IoeuffiuttQn.HiLite(5$x»,Ypcs) ; 
end; 


functicn  Imenu. Action (J^xs,Ypos:vrord)  tboolecui; 

{ 


*  * 

*  FJRPCSE  * 

*  Action  method  for  a  scrollable  list  of  items.  * 

*  * 


************************************************************************ 

) 

var 

dummy  :  boolean; 

i  :  integer; 

path:  pathstr; 
dir:  dirstr; 
name:  namestr; 
ext:  extstr; 

begin 

dumny  :*  DiEectoryList.Action(X^,Ypos) ; 

if  VBar, Action (54x36, Ypos)  then  begin 
listposition  :»  round  (VBar. Value) ; 

DisplayDirectoryList ; 
end; 

if  DirectoryMaskButton.Action(54x3s,Ypos)  then  begin 
DisposeOldDirectoryliist  ; 

GetNewDirectoryList ; 

DisplayDirectoryList ; 

VBar.  Shew; 
end; 

FOR  i  ;=  1  TO  maxlistsize  DO 
IF  directorylist.buttonarray[i]. selected  THEN 
begin 

IF  ((directorylist.buttonarrayrij.name  =  ")  OR 
(direccorylise.buctnnarray[il.naroe  =  '<xcp>')  OR 
(directu:rylist.bjctonarray[ij.name  =  '<bottaii>') )  THEN 
begin 

directorylist .  butionarray  [  i } .  TumOf  f ; 
directorylisc.picicsd  :=  -1; 
end 
ELSE 
begin 
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path...:=  airectccynaskSutt^ 

F^>lit  (path,  dir,  name,  ext) ; 

selectedfile  :=  dir  +  directorylist.huttonarray[i].xjaiae; 
end; 
end; 

dunny  :=  ViewButton. Action (Xpos,Ypc3s) ; 

dunny  l£)adBLttton.Actian(}ipos,Ypos) ; 
end; 

function  ‘ImenuiReyAction  ,  Ypos: word;  integer),  rboolean ; 

{ 


*  * 

*  PURPOSE  * 

*  Hotkey  action  method  for  a  scrollable  list  of  items.  * 

*  * 


} 

var  dumny  :  boolean; 
begin 

KeyAction  ;*  false; 

if  (Viewfiiitton.K^Action(Xpos,Ypos,)cey))  then 
KeyAction  ;»  true; 

if  (loadButton. KeyAction ()^x3s,Ypos, key))  then 
KeyAction  :*  true; 

end; 


procedure  Imenu. Cancel; 

{ 

********\V********************i*t************************'****************** 


*  * 

*  PURPOSE  * 

*  Method  for  removing  the  scrollable  list  fron  the  display.  * 

*  * 


************************************************************************ 

) 

var  i: integer; 
begin 

DisposeOldDireccoryList ; 
menu. Cancel; 
end; 


(*****************  iRcl’ude  the  methods  for  the  side  ard  lower  status  bars  ****) 
{$!  statbars.pas) 


Qanstructor  dmenu.Init(3$os,Ypos:wDrd;Alink:ActicnPrccsdure) ; 
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{ 

******************  **jHHt*****  ********  Jtilr**j>r**ili***jH>r**************i>t*<r*i>t**** 


*  * 

*  PURPOSE  * 

*  Methcxi  fca:  initializing  the  difference  menu  selections.  * 

*  * 


} 

OCTlSt 

me  =  cyan;  { 

mbc  »  blade;  { 

be  =  vdiite;  { 

he  *  lightblue;  { 

sc  *  yellow;  { 

to  *  black;  { 

htc  «  vfhite;  { 

stc  «  black;  { 

ems  »  18;  { 

var 


menu  color  } 

menu  border  color  } 

button  color  ) 

hilite  color  ) 

selected  color  } 

text  color  } 

hilited  text  color  ) 

selected  text  color  ) 

edit  menu  spacing  constant  ) 


f* 


labelarray :  namearray ; 
first;  integer; 
begin 

menu.Init  (Xpos ,  Ypos ,  305 , 90 , me, mbc, 2 , WindewShadewWidth) ; 
first  ;»  y+10; 

lothresh.Init(X+  75, first, be, he, be, htc,  -l,l,0.001,linearscale, 'LoLim' ,  ",0,3)  ; 
hithresh.Init(X+  75,first+ems*l,bc,hc,tc,htc,-l,l,0.00l,linearscale,  'HiLim',  ",0,3) ; 
labelarcayCl]  :»  chr(127)  +  'PSA' ; 
labelan:ayC2]  :»  '%'+chr(127)+'PSA'; 

IabelarxayC3]  :»  '%'+cJir(127)+' (l-PSA) '; 

DiffMode.Init(X+  50,first+ems*2,75,10,bc,hc,sc,tc,htc,stc,  'Mode'  ,3,1,  labelarray,  horizo 
acc^.Init(X+lOO  ,first+eras*3,100,16,bc,hc,tc,htc,  'Acc^'  ,Alihk,  'A') ; 
end; 


procedure  dmenu.Shcw; 

{ 

************************************************************************ 


*  * 

*  rURPOSE  * 

*  Method  for  displaying  the  difference  menu  selections.  * 

*  * 


} 

begin 

menu. shew; 
diffmcde.shcw; 
lothresh.shcw; 
hithresh.shcw; 
accept,  shew; 
end; 
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procedure  dmenu.Hi  Lite  (^tpcs,  word) ; 

{ 

*******************Tlr<t****  **  *  *  *  *  *  *■»***********************•*********'****** 
*  * 

*  PURPOSE  * 

*  Method  for  highli^tirg  the  difference  menu  selections.  * 

*  * 
************************************************************************* 

) 

begin 

menu.hilite  pspoe ,  Ypos) ; 
diffmode.hdlite(3$)os»Ypos) ; 
lothresh.hllite(Xpos,Ypos) ; 
hithresh.hilite(Xpos,Ypos)  ; 
acc^.  hilite  (X^ ,  Ypos) ; 
end; 


function  dinenu.Action(X^,Ypos:word)  :boolean; 

{ 

*****'********************'it***'*******************'************************ 


★  * 

*  PURPOSE  * 

*  Action  method  for  the  difference  menu.  * 

*  * 


************************************************************************ 

) 

var 

duraray:  boolean; 
begin 

action  ;=  false; 

dunany  ;*  menu. action (J$X3S, Ypos) ; 

dummy  ;=  diffmode. action (3$xds, Ypos) ; 

IF  (lothresh. action ()$X3S, Ypos) )  THETT 

IF  lothresh.value.value  >  hithresh. value. value  THEN 
begin 

hithresh.value.value  ;=  lothresh.value.value; 
hithresh. shew; 
end; 

IF  (hithresh. action (}$X!S, Ypos))  THEN 

IF  hithresh.value.value  <  lothresh.value.value  THEN 
begin 

lothresh.value.value  :=  hithresh.value.value; 
lothresh.shcw; 
end; 

duniny  ;=  acc^t. action (3^>os,  Ypos ) ; 
end; 


function  droenu.KeyAction(}^X!S,Ypcs:word;Key;integer)  tbcolean; 
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) 

var- 

duimy:  boolean; 
begin 

Reyacticjn  :«  FALSE; 

duiiu^  i—  w£rui.ksyaCtxori(j^jos,YpoSfj(By) ; 
dunny  ;«-diffncde.ki^ction(}{^»Ypos»key) ; 
cJurany  ;=  Icrthresh.keyaction (3^X36, Ypos, key) ; 
dunray  :=  hithresh.keyact:ion(3$x3s,Ypos,key) ; 
keyaction  ;*  acc^.keyaction(kJX)s,Ypos,key)  ; 
end; 


Ccnstructor  en]enu.Init(3toDs,Ypc3s:vrord;Rlink,Wlink, Blink, Plink:ActionProcedure) ; 

{ 

itiiitiirit**************************^!**************************************** 


*  * 

*  HJRPOSE  * 

*  Method  to  initialize  the  controls  on  the  edit  menu.  * 

*  * 


) 

Const 

me  =  cyan;  {  menu  color  } 

ffibc  *  black;  {  menu  border  color  } 

be  =  wliite;  {  button  color  } 

he  =  lightblue;  {  hilite  color  ) 

sc  =  yellow;  {  selected  color  ) 

tc  *  black;  {  text  color  ) 

htc  *  vhite;  {  hilited  text  color  } 

stc  *  black;  {  selected  text  color  ) 

eras  =»  18;  {  edit  menu  spacing  constant  ) 

var 

first  ;w3rd; 
labelarray :  namearray ; 
iiinteger; 
begin 

menu .  Init  ( Upas ,  Ypes ,  52 5 , 2 3 0 ,  me ,  mtc ,  2 ,  WindewShadewWidth )  ; 
first  :=  YtIO; 

Fsa  .Init(X-r  40, first, be, he, tc, htc, 0.5, 0.999,0. 001, linearscale, 'Psa 

SNR  .Init(X+  40,firstTeins*l,bc,hc,tc,htc,-99,99,l,linearscale, 'SNR' 

ShortLongRatio  .Lnit(X-f  40,first+€!ns’»2,bc,hc,tc,htc,-9S,99,l,linearscaie, 'S/L' 

XAngle  .Init(X+  40,first'fer[is-*3,bc,hc,tc,htc,0,90,l,linearscaie, 'ANG', ' 
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HiaseDev-  .Init'(X+-  40vfir:^+eras^4'>]x:>hc>tC',litG',’0,50^1vli^^  , ' 

(2X>P  .Init(X+  40/fizst+«ns*5,bc,hc,tc,hto,0,25AAinearscale,'GDP'/ 

labelarray[l]  :*=  'OFF'; 
labelarTay[2]  :=  'CN'; 

EM  .Init(X+  40,first4«ns*6,35,10,bc,hc,sc,tc,htc,stc,'EM',2,2,labe 

{ 

labelarray[l]  :=  'KAN'; 
labelarray[23  ;=  'DET'; 

PsaCalculateMode  .Init(X+  40,first+enis*6,35,10,bc,hc,sc,tc,htc,stc, 'CAL',2,2,lab 

) 

label  array  [1]  :*  'MIN^; 
labelarray[2]  :=  'MEAN' ; 
labelarray[3]  :=  'MAX,^- 

PsaReportMcde...  .Init(X+  40,first+€ins*7,35,10,bc,hCfSc,tc,htc,stc,.'REP',3;l,lab 

labelarray[l]  :=  'BEST'; 
labelarray[2]  ;*=  'NCM'; 
labelarray[3]  :=  'WRST'; 

.gi-ai-i nnp«»l  1  ah-i  1 1  t^7^fcdel . Init (X+  40,first+€ins*8,35,10,bc,hc,sc,tc,htc,stc,  'SKM' ,3,2,lab 

ManthSelectorsClj.Initf  x+40,fir3t4ents*9,30,10,bc,hc,sc,tc,htc,stc,MonchNaroes[lj); 
PCR  i  :=  2  TO  12  DO 

MonthSelectors  [  i  ] .  Init  (MonthSelectors  C  i”l  ]  •  X+3 1 ,  f  irst+ems*9 ,30,10, 
bc,hc,sc,te,htc,sta,McjnthNainesCi])  ; 

HourSelectors[l].Init(  X+10,first+€ins*10,20,10,bc,hc,sc,tc,htc,stx:,HourNaroesCrj) ; 
Ft»  i  :»  2  TO  24  DO 

HourSelectorsfi]  .Init(HcxirSelectorsCi-l]  .X+21,first+€ins*10,20,10, 
bc,hc,sc,tc,htc,stc,HcurNaines[i] )  ; 

first  :»  yflO; 

FOR  i  :*  1  TO  8  DO 

StatianPower[i]  .Init(X+260,first+ems*(i-l)  ,bc,hc,sc,tc,htc,stc,-20,20,l,linearscale,st 

labelarrayfl]  :=  '10.2'; 
labelarray[2]  :*  '13.6'; 
labelarray[3]  :=  'AND'; 
labelarray[4]  :=  'OR'; 

Freq.I.nit(X+260,first+e!ns*3,’35,10,bc,hc,sc,tc,hrc,stc,  'FPQ' ,4,1,  labelarray,  horizontal) 

Reliability. Init (X+10  ,first+ems*ll,100,16,bc,hc,tc,htc,  'Reliability'  ,Rlink,  'R') ; 

Weiciits  .Init(X+10+120,first+ems*ll,100,16,bc,hc,tc,htc,  'Wei^ts'  ,Wlink,  'W')  ; 

Batch  .Init(X+10+240,first+enis*ll,100,16,bc,hc,tc,htc,  'c^Jeue', Blink,  'U')  ; 

Process  .Init(X+10+-360,first+€ms*ll,100,16,bc,hc,tc,htc, ' Process ',Plink,  'P')  ; 

QRfile  :=  DEEALTT2RFIIE; 

Weightsfile  :=  CEFAIItiroEISnSFIIE; 
end; 


procedure  ejnenu.Shcw; 
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{ 


*  Method  to  di^lay  the  controls  on  the  edit  menu.  * 

*  * 
it*******************************'***********************************'***'** 


) 

VAR. 

i:  integer; 
begin 

reccnpjte  :=  FALSE; 
rethreshold  ;=-EALSE; 

menu.shov; 


SaveBditParams  ( @self ,  savet^arams) ; 


Psa 

.Show; 

SNR 

.Show; 

Shortlongr?atio 

.Show; 

XAngle 

.Show; 

EhaseDev 

.Show; 

m 

.Shew; 

GDOP 

.Shew; 

PsaCalculatdJtode 

.Show; 

StationReliabilityModel 

.Shew; 

Freq 

.Shew; 

PsaR^rtMode 

.Shew; 

PC3R  i  ;*  1  ro  8  DO 

stationpcwer[i]  .shew; 

K3R  i  :=  1  TO  12  DO 

MonthSelectors[i3  .Shew; 

FOR  i  :*  1  TO  24  DO 

Hc«rSelectors[i]  .Show; 
Reliability .  Show ; 

Weights  .Shew; 

Batch  .Shew; 

Process  .Show; 

end; 


procedure  eroenu.  Hi  Lite  (}axa;Ypcs;  word) ; 

{ 

***********'**3lt*************************'**********************'*'**lit******-> 
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HiRKSE- 

Method  to  highli^t  the  controls  on  the  edit  menu. 


i:  integer; 
begin 

menu.HiLite(3^x3s,Ypos) ; 

Psa 

SNR 

ShortlraigRafeio 

XAngle 

HiaseDev 

DM 

(3XDP 

PsaCalculat^iode 


.HiIjite(:x^x»,Y^} ; 
.HiLite(3^X5S/Ypos) ; 
.HiLite(3^x»>  Ypos) ; 
.HiLite(xix!s,Ypos) ; 
,HiLite(3<Jxs,Ypos) ; 
.HiLite(}^xs,Ypos) ; 
.Hild,te(){fr3s»Ypos) ; 

.HiLita(Xix»,Ypos) ; 


StationReliabilityMcdel.HiLite (:4x5s, Ypos) ; 
Freq  .HlLite (:4x5s,  Ypce) ; 

PsaRi^rtMode  .HiLite(X5x5s,^45os) ; 

PCR  i  ;«  1  TO  12  DO 

MonthSelectorsCi]  .Hilite  (:450s,  Ypos) ; 


P3R  i  :«  1  TO  24  DO 

HourSelectors[i]  .Hilite (:450s, Ypos) ; 

TOR  i  1  TO  8  DO 

statiorpcwer[i]  .Hilite (Xpos,  Ypos) ; 

Reliability.HiLite(:!45os,Ypos) ; 

Weights  .Hilite (Sxs,  Ypos) ; 

Batch  .Hilite  (Xpos ,  Ypos) ; 

Process  .Hilite  (:450s,  Ypos) ; 

end; 

functicsn  ainenu.Action(:45cs,Ypcs:vrord)  ;boolean; 

{ 

******'»t*****x*********'*'******1*»^lr'******'******'jif*'**********'**lic***7t*5t******1t 


*  * 

*  FJRPCJSE  * 

*  Method  to  activare  the  controls  on  the  edit  menu.  * 

*  * 


**************'***'***************'**'*****Hr**'»f***W**'*1»*****1lr')r'5it»****'**w***w* 

} 
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var 

dunny:  bc»lean; 

St:  shortstring; 
irinteger; 
begin 

{  if  any  of  the  following  change  then  the  cell  data  loust  be  rethresholded  ) 
rethreshold  :=  Bsa  .Action (34x3S,lipos)  OR  rethreshold; 

rethreshold  ;*  PsaPeportMode  . Action (3^xs,Ypos)  CR  rethreshold; 

PGR  i  ;*  1  TO  12  DO 

rethreshold  ;*  MonthSelectors[i].Action(32pos,T^x»).  OR  rethreshold; 

PCR  i  :*  1  TO  24  DO 

rethreshold  :=  HourSelectors[i]. Action (3^x3S,Ypos)  OR  rethreshold; 


{ 

) 


{  if  any  of  the  following  change  then-  the  cell  data  must  .be  reccnputed  } 


reccnpute 

recccpute 

reccopite 

reccwpute 

reccqpute 

recarpute 


SNR 

ShortlongRatio 

XAngle 

HiaseDev 

DM 

GDOP 


•Action  ,  Ypos) 
.Action  (3^pos,Ypos) 
.Action  ()$»s ,  Ypos) 
.Action  ,  Ypos) 
.Action  (Xpos ,  Ypos) 
.Action  (}^X5S ,  Ypos) 


OR  reccnpute; 
OR  recat|xcte; 
OR  recarpute; 
OR  recarpute; 
OR  recarpute; 
OR  recarpute; 


recarpute 


PsaCalculat^dode 


.Action (G^xs, Ypos)  OR  recarpute; 


reccnpute  ;=  StationReliabilityModel .Action (Spos, Ypos)  OR  recarpute; 
recarpute  ;*  Freq  .Action (Xpos, Ypos)  CR  recarpute; 

PGR  i  :»  1  TO  8  DO 

recarpute  :=  statioipower[i]  .Action(3$)os,Ypos)  OR  recarpute; 


(*  REPLACE  THE  PDIICWB^  IWD  UNES  WITH  SCMEIHING  UKE  THIS  *) 

recarpute  :=  Reliability. Action (}$)os, Ypos)  OR  recarpute; 
rethreshold  :=  weights  .Action (Xpos, Ypos)  OR  rethreshold; 

(*  WHEN  IHE  RELIABILITY  BUITCN  AND  WEIGHTS  BOTTONS  GET  HOOKED  UP  *) 
(* 

duirttty  :*  Reliability .Action(Xpos, Ypos) ; 

dumity  :=  Weights  .Action (3^X5S, Ypos) ; 

*) 

dumny  :=  Batch  .Acticn(}pxcs,Ypos) ; 

dmty  ;=  Process  .Action(3^x)s,Ypcs) ; 

end; 


function  e!rrenu.KeyAction(XEx:s, Ypos; word;  key: integer) : boolean; 

{ 

*************'************'*'***»****'**'*'»r**n'jir'**x**w*******'»t************')C'5»** 


*  * 

*  HJRKSE  * 

*  Method  to  activate  the  controls  on  the  edit  crenu  based  * 

*  on  a  hotkey  input.  * 
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****SMhk**^Wt*«Mk***1Hk**lHk*******#******sk*aHHIMt****.*'lMtilWk**Sk***#ll('************^. 

} 

var  dumny  :  bcxslean; 
begin 

K^Acticn  false; 

if  (Reliabili^.KeyAction{3<^,ypcs,]cey))  then 
ReyAction  :=  true; 

if  (Wei^its.R^Action{3$x3s,Ypos,)oey’))  then 
Reyftction  :*  true; 

if  (Batch. KieyAction(3^x5s,Ypos,}cfiy))  tten 
KeyActicn  :=  true; 

if  (Process.ReyAction(3^x:s,Ypos,)oey)  then 
KeyActicn  :*  true; 

end; 


procedure  emenu. Cancel; 

{ 


*  * 

*  HJRPCSE  * 

*  Method  to  remove  the  edit  sc^a^.  frgn  the  display.  * 

*  ★ 


*********************************************iit*******************»t****** 

) 

var 

key, button  :  integer; 
begin 

if  (rethreshold  or  recoipite)  then 
begin 

messagebox.displayroessage((GetMaxX  DIV  2)  - 
(textwidth( '123456789012345')  DIV  2) , 

(GetMaxY  DIV  2) ,  1, 
length  ( '  123456789012345 ' ) 

,  lightmagenta ,  black, 

(*'123456789012345'*) 

'  Quit  Edit  ?  '); 

beep; 

r^jeat 

Get_Rey(ki^) ; 
button  :*  GetJButtons; 
until  (key  =  ENTER)  or 
(key  =  ESC)  or 
(upcase(chr(key) )  =  'Y')  or 
(\;ttX2se(chr(key) )  =  'N')  or 
(button  o  0) ; 

messagefaox .  hidemessage ; 
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if  (]oey  =  ENTER)  or 

(button  =  leftJxrt*on_pressed)  or 
(;?5case(chr(3c^))  =  'Y')  then 
begin 

menu,  cancel; 

RestoreEditParains(@self,save<^5arains) ; 
end; 
end 
else 
begin 

menu.  Cancel; 

RestoreEditParams  ( @self ,  save<^»raffis)  ; 
end; 
end; 


(**************  Include  auxiliary  object  method  code  here  *****************) 

{$!  cellwin.pas) 

{$!  memoarea.pas} 

{$I  savemenu.pas) 

{$!  helpmenu.pas) 

var 

Dirinfo  :  Seart±Rec;  (*  SearchRec  is  defined  in  the  Dos  unit  *) 
begin 

{  allocate  area  to  hold  edit  parameters  for  the  edit  menus  etc  ) 
new(save<^arams) ; 

{  initialize  a  utility  message  box  ) 
roessagebox.init(0/0,0,0,0,0,l,WindcMShadc:wWidth) ; 
batdiqueue  ;=  NIL; 
tcpofbatchqueue  ;=  NIL; 
end. 
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^ *********************************************************************** ' 


*  * 

*  EROGRAM  NAME  -  Onega  Perf onnance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Worlcstation  ★ 

*  * 

*  UNIT  NAME  -  EROCS  Uhit  * 

*  * 


************************************************************************ 


* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 


* 

This  .programt^was  pr^sared-  by  * 

* 

Ibe  Analytic  Science  Corporation  (TASC)  * 

55  walkers  Brook  Drive  * 

Reading,  Massachusetts  U1867  * 

* 

PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  ccanpatible  * 
under  MS-DCS  3.3  or  higher  with  a  ninimuin  of  640K  of  main  * 

memory  and  an  EGA  or  caicatible  graphics  adapter  and  color  * 
monitor.  Uiis  work  was  p^ormed  ui^der  contract  number  * 

DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

the  Omega  Navigation  System  Center  (OJSCEN) ,  Alexandria,  VA.  * 

* 


************************************************************************ 


* 


* 


*  HJRPOSE  * 

*  Hiis  unit  contains  a  collection  of  procedures  that  are  * 

*  dynamically  assigned  to  object  methods  for  the  objects  * 

*  declared  in  the  PACEOBJS  unit.  Basically,  all  of  the  * 

*  PACE  specific  action  procedures  are  contained  herein.  * 

*  Ihe  files  EROCS2.PAS  and  PR0CS3.PAS  also  contains  portions  * 

*  of  this  unit.  * 


************************************************************************ j 

{$N+,E+) 
unit  procs? 


Interface 


Uses  crt, Graph, CursrCbj,CellUtil,qRutil, Controls, 

ConMan,  Pacecfajs ,  Pacelnit ,  DataUtil ,  d:s  ,  Erring; 


TYPE 


Wei^tsDataType  =  record 

Cnranent  ;  string; 

WeightData  :  array[1..444]  of  byte; 
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end; 


WeightsFile  =  File  OF  WeightsDataType; 
var 

leftexpanded ,  righteacpanded;  bcnlean ; 

{  indicated  vAiicii  window  is  currently  expanded  ) 

QueueSa\reCcninent,Wei^tsSayeOcnE-2nt,LeftSaveCcinment,RightSaveCcaiiment;  CaranentAreaType; 

QRDataba.qe;g^Dataha.qeptr; 

f ilemenunamelist ,  cptionsmenunaroelist :  PickMenuNaroeArray  ; 
filemeniprocedurelist ,  ciptionsmera5)ra»durelist:  PickMenuActionArray  ; 
filemenuhotkeylist,  optionsroenuhotJc^list:  PickMenuHotKeyArray ; 


Procedure  CcnputePsa(^rtr:eneni5rtrr;  Iptrrlbarptr) ; 

procedure  OopyCells(£iaiptx’,tcptr;ce3.1gric^rtur) ; 

procedure  quitbutton; 

procedure  helpbutton; 

procedure  filebjtton; 

procedure  cptionsbutton; 

procedure  leftfilebutton; 

procedure  ri^ttfilebutton; 

procedure  editbutton; 

procedure  loadbutton; 

procedure  savetutton; 

procedure  returnbutton; 

procedure  Coveragereturnbutton; 

procedure  DifferencePetumButton; 

procedure  auxsavebutton; 

procedure  saveaction; 

procedure  auxsaveaction; 

procedure  auxloadbutton; 

procedure  auxeditbutton; 

procedure  splitbutton; 

procedure  rightexpandbuttcn; 

procedure  leftexpandbutton; 

procedure  editmenuprccess; 

procedure  auxeditmenuprocess; 

procedure  ShowCei 1 Data (selfptr  :  CellPtr) ; 

procedure  ShcwCoverageCellData  (selfptr:  CellPtr) ; 

procedure  stub; 

procedure  SaveArchiveParamerersCVAR  AF;ArchiveFile;  K«u:;emenupcr; 

VAR  caiiienc;carar£riraieat^  ; 

procedure  RestoreArchiveParamecers  (VAR  AF:  Archivefiie;epcr:emenupor; 

VAR  caiment:came.Tt:areaoype)  ; 

procedure  RelhresholdCells(C::sxr:  CallGridPtr;  eptrtememito-; 
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IpteiUaarptr)  ; 

procecSure  Ri^itCell  GridAction(selQ?tr  :  cellPtx;  cellnumber:  integer) ; 

procedure  LeftCel IGridftction ( selQrtnr  :  CellPtr;  cellnumber:  integer) ; 

procedure  BigCellGrldAction  (selJ^^tr  :  CellPtr;  cslliiumber:  integer) ; 

procedure  SubCellftction  ( selQytr  :  CellPtr;  cel  I  number:  integer) ; 

procedure  listmenuaction; 

procedure  rigfatlistmenuaction; 

procedure  listmenuview; 

procedure  ric^titlistmenuview; 

procedure  reliabilit^menuview; 

procedure  aujcreliabilitymenuview; 

procedure  ReliabililyAction; 

procedure  AuxReliabilityAction; 

procedure  QueueAction; 

procedure  AuxQueueAction; 

procedure  gueuesaveAction; 

procedure  auxqueuesaveftction; 

procedure  processbatciiqueue; 

procedure  aioqjrocessbatchgueue; 

procedure  CoverageActioi; 

procedure  CoverageCellGridAction(sel^3tr  :  CellPtr;  CellNumber:  integer) ; 

prccedure  RelliistMenuAction ; 

procedure  AupdRel T li  frtMenuAction; 

procedure  lDoNothingProc(sel35ptr  :  CellPtr); 

procedure  Wei^tslistmenuaction; 

procedure  VJeightsloadbutton; 

procedure  ShowWeightsCellData(selfptr  :  CellPtr) ; 

procedure  Weic^itsSaveButton; 

procedure  Weightssaveaction; 

procedure  Wei^rtslistmenuvdew; 

procedure  Wei^tAction; 

procedure  AuxWei^itAction; 

procedure  G€tWei^tSet(^rtx;en3erir?jtr;a^^  :  CellGridPtr;  fname  :  string) ; 

procedure  WeightsCellQridAction(sel£ptr  :  CellPtr;  cellnumber:  integer) ; 

procedure  Wei(^tsCellGridCancel(selfptr  :  CellPtr); 

procedure  Wei(^_or_RBgion_Bucton; 

procedure  DrawCells{selfptr  :  CellPtr) ; 

procedure  WeightsGrxpButton; 

procedure  differencebuttcn; 

procedure  differenceacceptbutton; 

procedure  Dif fCellGridAction  ( selfpcr  :  CellPtr;  cellnumber;  integer) ; 
procedure  ShcwOiffCellData  (selfptr  :  CellPtr) ; 
prccedure  NextAction; 
prccedure  PreviousActicn; 

laplementaticn 

CONST  NUMElERCEIiS  =  444; 
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VRR 

SNPThiesiiold,  Shortljongl^^  HiaseOireshold, 
Xftngl€)Ihreshold,(TOPItireshold:  integer; 
EMIhreshold:  boolean; 


{$F+} 


^★********************* ***************************************************** j 


procedure  Cc|yCells(£iT3iptr,tcptr:cellgri(^3tr) ; 

{ 

***********5('********************1lt*************************************** 


*  * 

*  lURPOSE  * 

*  Hiis  procedure  will  copy  the  contents  of  a  cellgrid  to  * 

*  another  when  we  sfplit  or  expand  screens  * 

*  * 

*  * 


★★★★★★★★★★★★♦★★★★★★★★★★★★★★★★★★★★■JUb***************:********************** 

} 

var 

i:  integer; 
begin 

for  i  ;=  1  TO  NUMBERCKrJS  do 
begin 

tcprtJT.cellarrayCi]. abovethreshold  :*  fr acptr^ » cellarray [ i ] . abovethreshold  ; 
tcptr^.cellarrayCi]. region  ;*  frotptr^. cellarray [i] .region  ; 
toptr' .  cellarray [  i] . wei^tjorjxiverage  ;= 

frcciptr*' .  cellarray  [  i] .  wei(^t__or_coverage  ; 
tcptr^. cellarray [i] .Pac  :=  frtaptr'. cellarray [ i] .Pac  ; 
end; 
end; 


(***★***********■********■»■*******★*****■*****•*★***■***★*****★*****■*************  j 

procedure  quitbutton; 

{ 

*************************************************************************** 


*  * 

*  roPFOSE  * 

*  Ihis  procedure  handles  the  action  of  exiting  the  PACE  * 

*  system.  It  checks  to  ensure  that  the  user  will  not  lose  * 

*  results  accidentally  by  forgetting  to  save  them.  * 

if  ★ 


) 
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var- 

f  :  file; 

key,lxrt±on  :  integer; 
begin 

if  (LeftlnwerStatus'^ .  arcfaivef ile  =  IEFTI2I3tt3in3^RCHIVE)  or 
(Ri^itIo>«rStatus‘'.arcliivefile  =  RIGHITWADIinVRCHEVE)  or 
(topofbatchgueue  o  NIL)  then  begin 
messagdxac.  displaymessa^  ( (GetMsoX  DIV  2}  > 

(textwidthC '123456789012345678901234567890123456/)  DIV  2), 
(GetMaXy  DIV  2),  1, 

ler^( '  123456789012345678901234567890123456 ' ) 

,  lightred/black,' . 

(*^'1234567890i2345678901234567890123456t*) 

'  «<  WARNING  -  DAIA  MAY  BE  IDST  »>  '+ 

f  ********************************  /+ 

'  '+ 

'  Unsaved  Scenarios  or  '+ 

'  Batch  Files  Exist  '+ 

'  Exit  PACE  ?  ') ; 

beep; 

end 

else  begin 

messagebox,displayinessage((GetMaxX  DIV  2)  - 
(textwidth('Exit  PACE  ?')  DIV  2), 

GetMaxY  DIV  2,1. 
length('Exit  PACE  ?') 

,lightrBd,v4ute, 

'Exit  PACE  ?') ; 

beep; 

end; 

repeat 

Get_Key(key) ; 
button  ;=  Get_Buttons; 
until  ()cey  =  ENTER)  or 
(key  *  ESC)  or 
(Incase (chr (key))  =  'Y')  or 
(vpcase(chr(key))  =  'N')  or 
(button  o  0)  ; 

messagebcK.  hidemessage  ; 

if  (key  =  ENTER)  or 

(button  =  left_button_pressed)  or 
(upcase(ahr(key))  =  'Y')  then 
begin 

QUIT  :=  TRUE; 
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else 

QUIT  :*  ERLSE; 

end; 


procedure  helpbutton; 

{ 

****vc*******jHHIt******************************************)lnlHHr^t**^r****^r** 

* 

lUEPOSE  * 

This  procedure  invokes  the  help  subsystem  by  pu-iiing  the  * 
help  systan  context  onto  the  -contend:  stack'  and  then  showing* 
the  context,  * 

* 

★A********************************************************************** 


* 

* 

* 

* 

* 

★ 


} 

begin 

HelpMenuWindow^ .  HelpFileNane  ;  =  FileName  ( CurrentOontext) ; 
pushcontext  ( 'helpinenuwindow' ) ; 
shcMxntexc; 
end; 


(***********************************★*************************************** j 


procedure  filebutton; 

{ 


*  * 

*  PURPOSE  * 

*  Ciis  procedure  activates  the  file  menu  for  the  main  * 

*  cell  display  screen.  * 

*  * 

*  * 


************************************************************************ 

) 

begin 

pushcontext  ('filemenu') ; 
shcwcontext; 
end; 


(******•***************•*■**********★★******★★**•******★*******★****************  j 

procedure  cptionsbutton; 

{ 


★  * 

*  PURPOSE  * 

*  Ihis  procedure  activates  the  options  menu  on  the  weights  * 

*  editor  screen.  * 
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} 

begin 

pushcQnte3£t(^cptionsmenu')  ; 
showcontext; 
end; 


procedure  leftfilebutton; 

{ 

*  * 

*  PURPOSE  * 

*  Hiis  procedure  activates  the  file  menu  for  the  left  split  * 

*  cell  display  screen.  * 

*  * 


*  * 
************************************************************************ 

} 

begin 

pushcantext('leftfilemenu') ; 
showcontext; 
end; 


(**********★******★*****★■*★*****★★**★******★**★********★*******************★) 
procedure  rightfilebutton; 


************************************************************************ 


* 

★ 

★ 

* 

* 

* 


* 

PCRPOSE  * 

This  procedure  activates  the  file  menu  for  the  ri^t  split  * 
cell  display  screen.  * 

★ 

* 


******************  *i^***************iWf*********ilr************************* 

) 

begin 

pushcontext  ( '  rightf ilemenu ' )  ; 
showcontext; 
end; 


procedure  editbutton; 
{ 
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it  ★ 

*  PURPCSE  * 

*  !Ihis  procedure  activates  the  edit  menu  for  the  main  * 

*  cell  display  screen.  * 

*  * 

*  * 


************************************************************************ 

) 

begin 

IF  ri^te^qanded  IHEN 

pushocntesct  ( '  auxeditmenu ' ) 

ELSE 

pushcontext('editmenu') ; 
shoMcontext; 
end; 


^************'***************************************************************j 

procedure  loadbutton; 

{ 

************************************************************************* 


*  * 

*  H3RP0SE  * 

*  Ciis  procedure  activates  the  load  menu  for  the  main  and  * 

*  left  cell  display  screen.  * 

*  * 

★  * 


itititicicititititiciticitititititicititititicicitititicieiticititieiticieititicieitititieiticieiticiticicicititieiticicicicicieicieieieiticitit 

} 

begiri 

IF  rightejqanded  IHEN 

pushcontext  ( 'rightlistmenu' ) 

ELSE 

pushcontext  ('listmenu') ; 
shcwcontaxt; 
end; 


^***^t*************'****************'******************************************j 

procedure  savabutton; 

{ 

**********'************'***'***'**Tif***n:'*'5f**o»******'**'»r***'**'*****'*'*'***'******** 


*  * 

*  KIRPOSE  * 

*  Biis  procedure  activates  the  save  menu  for  the  main  * 

*  cell  display  screen.  * 

*  * 

*  * 
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} 

begin 

IF  Ric^itexpanded  THEN 
begin 

if  Ri^ili£>erStat3JS''.arciuvefile  o  RISDIEEADIID^RCHIVE  then 
SaveMenuWindcw^.FileButton.ChemgejString(Id^itIx»erStatxis^.archivefile) ; 
Sav^feni:^indaw^  -ManoBcoc.  GetNewText  (RightSaveCcrament) ; 
pushocntext  ( '  savementsdixlcw' ) ; 
end 
ELSE 
begin 

if  Leftlxjwerstatus^.archivefile  o  lEFlIiEFADinsVRagVE  then^ 

Sav^fenuWindow^ .  FileBiitton.  ChangejString  (I eftlowerStatus-*^ .  archivef ile) ; 
SavSisnuWinda^  .MemoBox.  GetNewText  (LeftSaveCciiiment) ; 
pushcontext ( ' savemenuwindcw' ) ; 
end; 

shcwxjntext; 

end; 

(*****************************************************'**********************j 


procedure  auxsavebutton; 

{ 

***iHt**ii**ii*ii*ii*iiiiit*ititit*iiii*iiiiitit*ii*1iit*1i*******it****ititiiit****ii*itit*******itit* 
*  * 


★ 

* 

it 

* 

* 


FURPOSE  * 

This  procedure  activates  the  save  menu  for  the  ri^t  ^lit  * 
cell  display  screen.  * 

* 

* 


*ic*itititii*iiiciiitiiiticit*ii**itii**M*itii*itit*ititit***it***ititit******itit**it*****it*it*itit*itititit 


) 

begin 

if  RightlrwerStatus-'. archivef n  o  RIC2DIEFAIEIIARCHrVE  then 
AuxSav^ienuWindow'' .  FileBattcn.  ChangejString  (RightlowerStatus'' .  archivef  ile) ; 
AuxSaveMemWindCMT  .MemoBox.  GetNewText  (RightSaveCcniment) ; 
pushcontext  ( '  auxsavemenuwindcw' )  ; 
shcwccntext; 
end; 


(**********  *'**»***'***»c**'***i«r*****il!***************'*  ■****★*******■********•*■**•**■*  J 


procedure  retumfcuthcn; 

{ 

*************»*******ie»**********w*****'**Tit**ilnit*****************'*******'5«:* 
*  * 
*  FURPOSE  » 
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*  Ihis  procedure  causes  a  return  from  therweights  editor  to  * 

*  the  edit  menu.  It  checks  to  see  if  the  user  has  changed  * 

*  anything  and  warns  the  user  if  data  may  be  lost.  * 

*  * 
********  it*******'*********************************************'*********** 

} 

VSR 

key^button  :  integer; 
begin 

IF  Wei^tCellGrid'^.BasBeenC5anged  THEN 
begin 

messageboK:.'displayroessage((GetMaxX  DIV  2)  - 

(textwidth(' 123456789012345678901234567890123456')  DIV  2) , 
(GetMaxY  DIV  2) ,  7, 

ler^  ( '  123456789012345678901234567890123456 ' ) 

,  lightred, black, 

( * ' 123456789012345678901234567890123456 ' *) 

'  '+ 

/  ******************************** 

•  «<  WARNING  -  DATA  MAY  BE  LOST  »>  '+ 

t  ********************************  '+ 

^  '+ 

'  tosaved  Wei^rt/Region  Set  Exists  '+ 

'  Exit  W^^t/Region  Editor  ?  ' ) ; 

be^; 


repeat 

Get_Key(ki^) ; 
button  :*  Get_Buttons; 
until  (ki^  =  ENTER)  or 
(key  =  ESC)  or 
(v:pcase(chr(key) )  =  'Y')  or 
(upcase(chr(ki^) )  =  'N')  or 
(button  o  0) ; 

oessagebox .  Mdemessage ; 

if  NOT(  (key  =  ENTER)  or 

(button  *  left_button_pressed)  or 
(\53case(chr(ki^))  =  'Y'))  then 
exit; 

end; 

hide_cursor; 

pcpcontext; 

cptiorsinenu''.buttonarray[2] .HotKey  :=  'R'; 
cptionsmenu''  .buttonarrayf 2]  .C2:angeNaiDe(  'Region' ) ; 
WeightCellGrid'^.Kzcr'.weightsfile  :=  WeightCellGrid''.weiOTtsfile; 
setvisualpage(O) ; 
setactive3age(0) ; 
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set_cajrsoi?jp^e  (0)  ;■ 

Set_Cursor_Sha^(arxcw) ; 

showMcurscrC  (GetMaxX  DIV  2) ,  (GetMaxX  DIV  2) )  ; 
end; 


procedure  CcverageRetirajButton; 

{ 

************************************************************************ 


*  * 

*’  roRPOSE  * 

* '  Diis  procedurescauses  a  return  ■frani<the  coverage-  display  *  * 

*  screen  to  the^detailed^tcell  query  level.  * 

★  * 

*  * 


************************************************************************ 

) 

begin 

hide_cursor; 

pcpcontext; 

(*  switchcontext('editinenuO ;  *) 

OoverageCellGrid^ .  cellarray  [CellPcpUp^  .HilitedCellPtx^ .  cellnumber]  .unhilite; 

setvisualpage(O) ; 
setactivepage(O) ; 
setjcursor_page(0) ; 

sh(:w_cursor(  (GetMaxX  DIV  2) ,  (GetMax!f  DIV  2) ) ; 
end; 


(^***************************************************************************'j 

procedure  DifferenceRetumButton; 

{ 

************************************************************************ 
*  * 


* 

* 

* 

* 

* 


PURPOSE  * 

This  procedure  causes  a  return  from  the  difference  display  * 
screen  to  the  split  screen  display.  * 

* 

* 


************************************************************************ 


) 

begin 

hide_cursor; 
pcpcontext; 
setvisualpage(O) ; 
setaccivK»ge(0) ; 
set;_cursor_page(0) ; 

show_cursor(  (GetMaxX  DIV  2) ,  (GetMaxY  DIV  2) )  ; 
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white, 

'Saving  to  file:  '+ARam/EPimif '\'+filename) 
J^ign(AF,ARa3IVEEMH4-'\'+filenaiae)  ; 

IF  (f^q)and(filenaine)  =  fe:5)and(leftl<werstatus‘'.archivefile))  THEN 
begin  {  if  saving  to  the  same  name  as  csicrently  loaded,  just  rewrite  the 
parameter  info  and  don't  save  anything  else  ('cause  it's  already 
there  } 

Beset  (AF)  ; 

SaveArchiveParameters(AF,editmenu,Leftsaveccinnent) ; 
aose(AF)-; 
end 
ELSE  * 

begin  {  storing  to  a  different  file  so- it '.s  OK-to.  rewrite  and  copy  } 
Rewrite  (AF) ; 

Assign(source,  ARCHIVEPA3H4-'\'+leftlcwerstatus‘'.archivefile) ; 
Keset(souroe) ; 

SaveArchiveParaneters(AF,editmenu,IeftSaveCcinroent) ; 

PC3R  i  :*  1  TO  NCells  DO 
begin 

Icadcenfraiiarchive (source, i,tarDp)  ; 
storecelltoarchive  (AF ,  i ,  taip) ; 
end; 

caose(AF)  ; 

Close  (source) ; 

leftlowerstatus'^.archivefile  ;*  filename; 
leftlcwerstatus^ .  show; 
end; 

messagebox.hidemessage ; 

hidecontext;  popcontext;  (*  wipe  out  the  save  memo  window  *) 
hidecontext;  popcontext;  (*  wipe  out  the  file  pick  list  drop  down  menu  *) 
end; 
end 
else 
begin 

roessagebox.displayinessage({GetMaxX  DIV  2)  - 

(textwidth('Save  Data  Not  Available,  Process  a  Scenario  First')  DIV  2), 
GetMax!^  DIV  2,1, 

length('Save  Data  Not  Available,  Process  a  Scenario  First') 

,lightred,  white, 

'Save  Data  Not  Available,  Process  a  Scenario  First') ; 

be^; 

messagewait; 
messagebox.hidemessage  ; 
end; 
end; 

^*********'******************'*******'*****»t»*'*'**i(t*********************'********j 
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procecSure  Sav^feigtitsParameters  ( filename  :  string;  ■ 

Ocranent  ;  CanmentAreaType  ) ; 


{ 

************************************************************************ 


*  * 

*  HJRPOSE  * 

*  Biis  procedure  performs  the  actions  necessary  to  save  a  * 

*  weight  set  to  a  weight  file.  * 

*  * 

★  * 


) 

var 

wd  :  Wtei^tsDataiype; 
WF  :  WeightsFile; 
i  ;  integer; 


begin 

Assign  (WF,  filename) ; 
rewrite  (WF) ; 
wd.Canment  ;=  Qanment; 
for  i  :»  1  to  444  do  begin 

wd.Wei^tData[i]  ;*  weightCellGrid''.CellArray[ij .Weight_or_Coverage; 
IF  Wei^tCellGrid^.CellArray[i] .region  THEN 
wd.Wei^tData[i3  ;»  vid.WfeightData[i3  OR  $80; 
end; 

write (WF,WD) ; 
close  (WF) ; 
end; 


(************** ************************************************************* j 

procedure  auxsaveaction; 

{ 

************************************************************************ 


»  * 

*  PURPOSE  * 

*  Biis  procedure  performs  the  actions  necessary  to  save  a  * 

*  scenario  and  it's  results  to  an  archive  file  for  the  * 

*  right  split  cell  displays.  * 

*  * 


*************************************************************************** 

) 

var 

dummy:  char; 
errorstring, 
filename  :  string; 

Soiree, AF;  ArchiveFile; 
i:  integer; 
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tenp ;  archivedcelltype  ; 
begin 

if  ric^TliLowerstatus''.archivefile  o  "  THEN 
begin 

filename  :=  itocSaveJienuWiixiiV^.FileButton.TtejctJiJtring; 

if  filename  =  "  then 

begin 

messagebcoc. di^laymessage ( (GetMaxX  OIV  2)  - 

(textwidth( 'Please  Select  An  Appropriate  Filename  before  saving. . . DIV  2) , 
GetMaxY  DIV  2,1, 

length  ('Please  Select  An  Appaxpriate  Filename  ^before  saving. . . ') 
,li^tred,vhite, 

'Please  Select  An  i^rcpriate  Filenase  before  saving. . . ' ) ; 

beep; 

messagewait; 
messagebooc.hidemessage ; 
end 
else 
begin 

AmSaveMenuWindaw*.J4einoBox.AssignChangedText(RightSaveCcriinent)  ; 

messagebox.displayroessage(  (GetMaxX  DIV  2)  -  (textwidth( 'Saving  to  file:  '+ARaii:VEPAT 

■(GetMax!^  DIV  2)  -  (textheight('l')  DIV  2), 

length  ('Saving  to  file:  '+ARaiIVEPAIH+'\'+filenaine) , 

ligfatred, 

white, 

'Saving  to  file;  '+ARCHIVEPA3Hf'\'+filename) ; 
Assign(AF,ARan:VEPATH+'\'+filename) ; 

IF  (fexpand( filename)  »  fe)q)and(ri(iitlcwerstatiis''.archivefile) )  THEN 
begin  {  if  saving  to  the  same  name  as  currently  loaded,  just  rewrite  the 
par?r3ter  info  and  don't  save  anything  else  ('cause  it's  already 
there  ) 

Peset(AF) ; 

SaveArchiveParameters(AF,auxeditmanu,RightSaveCcniinent)  ; 
aose(AF) ; 
end 
ELSE 

begin  {  storing  to  a  different  file  so  it's  OK  to  rewrite  and  copy  } 

Rewrite  (AF) ; 

Assign(scwix»,ARC3Ii:VEPAIIH-'\'+Rightlcwarstatus‘'.c»rciiivefile) ; 

Reset (source) ; 

SaveArchiveParameters  (AF,  auxeditnenu,Ri^tSaveCaiTOent)  ; 

FOR  i  :=  1  TO  NCalls  DO 
begin 

loadcellfranarchive(sourc8,i,tenp) ; 
storecelltoarchive(AF,i,te!:ro)  ; 
end; 

Close (AF) ; 
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dose  {source) ; 

ri^idoh^rstataas^.airhivefile  :=  filename; 
rightlowerstatus''  .show; 
end; 

messagdxoe.hidetnessage; 

hidecontext;  popcontext;  (*  wipe  cut  the  save  memo  window  *) 
hidecontext;  pcpcontext;  (*  wipe  out  the  file  pick  list  drop  down  menu  *) 
end 
end 
else 
begin 

messagebaxwdisplaymessage'((GetMaxX  DIV  2)  - 

(textwidth('Save  Data  Not  Available,  Pnx»ss<  a  .Scenario  First')  DIV  2) , 
GetMaxY  DIV  2,1, 

length('Save  Data  Not  Available,  Process  a  Scenario  First') , 
lightred ,  white , 

'Save  Data  Not  Available,  Process  a  Scenario  First') ; 

beep; 

messagewait; 
messagebox.hidemessage ; 
end; 
end; 


(********************************i(lr*******************************JViit**********J 


procedure  auxloadbutton; 

{ 

**★**★***★******★****■*  ************************************************** 


* 

* 

■it 

* 

* 

* 


* 

RJKPOSE  * 

Hiis  procedure  activates  the  load  menu  for  the  richt  split  * 
cell  display  screen.  * 

* 

* 


} 

begin 

pushcontext  ( 'rightlistmenu' ) ; 
shcwccntext; 
end; 


(**■***★******■******************•****■*  ******'*****5Ht*'**************************J 

procedure  auxeditbutton; 

( 

**************************************x**********************7e********** 
+  * 

*  FORFCSE  * 

*  This  prccedure  activates  the  edit  menu  for  the  right  split  * 
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} 

begin 

pushoontext  ( 'auxeditmenu' ) ; 
showcontext; 
end; 


(*******•**★★*★  **********ll(**************<rtlt***************************llt*******J 


procedure  splitbutton; 

{ 


if  * 

*  HJRPOSE  * 

*  This  procedure  activates  the  split  screen  cell  display  * 

*  mode.  * 

*  * 

*  * 


) 

begin 

IF  ri^tesqjanded  THEN 
begin 

deletefrancontext(  'basescreen^  ,ri^itlowerstatus) ; 
addtocontext  ( 'basescreen'  ,leftlcwerstatus) ; 
deletefraicontext(  'basescreen'  ,rightsidestatus) ; 
addtocontext ( ^basescreen^ ,  leftsidestatus) ; 
CcpyCells(BigCellGrid,Ri^tCellGrid) ; 
end 
EL^ 
begin 

CepyCells  (BigCellGrid ,  LeftCellGrid) ; 
end; 

pushcc2Ttext(' splitscreen') ; 
basescreen^ .  shc^; 

ShowCcntext; 
ri^itexpandfid  :=  FAISE; 
leftexpanded  :®  FALSE; 
end; 


(**********************************'*************^lt*'****************'X***'X**>!**J 


procedure  rightexpandbutton; 

{ 

**:********K'»***5t*')t***T«r»***i*'**5tW'ST*»t**Tlt*******'5»***Tf3Hlt***'X7r'»**>:*it*'»**'****x* 
*  * 
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*  PURPOSE  * 

*  This  procedure  causes  the  right  split  screen  display  to  be  * 

*  di^layed  in  full  screen  mode.  * 

*  * 

*  * 

*************************************************************************** 


} 

begin 

deletefrcncontext(  'basescreen^ ,  leftlcv^erstatus) ; 
addtocontext('basescreenSri^tlcwerstatus) ; 
deletefranoontext('basescreen',leftsidestatus) ; 
aciJtooontext  ( 'basescreen' ,  ri^tsidestatus) ; 
OcpyCells  (Ri^tCellGrid ,  BigCellGrid) ; 
ric^itexpanded  :»  TK3E; 
leftexpandfid  FALSE; 

HideContext; 

pcpcontext; 

ShCMContext; 

end; 


(*********★★*★****■*****★*★****★***********★*********•*★****★**★******★****★**) 


procedure  leftexpandhutton ; 

{ 

************************************************************************* 


* 


* 


★ 

* 

★ 

4t 


HJRPOSE  * 

This  procedure  causes  the  left  split  screen  display  to  be  * 
displayed  in  full  screen  mode.  * 

* 


★ 


★ 


) 

begin 

CcpyCe].ls  (LeftCellGrid ,  BigCellGrid) ; 
rightejqsanded  :=  FALSE; 
leftexpanded  ;=  TRUE; 

HideContext; 

popcontext; 

ShcwContext; 

end; 


^*'5f*'*'****'********'**'jlt'*********'**-<r**'jt*'i:*'»r*'9t'*********  ****★***•* '*'******3(5t  ■**★*★**■*  J 


procedure  stub; 

{ 

it  it 
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*  RJRPOSE  * 

*  This  is  a  dumny  procedure  that  is  used  to  detwg  object  * 

*  definitions  and  operation.  * 


) 

begin 

pushcontext('stub^) ; 
shOMOcntext; 
end; 


procedure  SaveAndiiveParametersCVAR  AFrArchivefile;  ^rtartemenuptr; 

VAR  cannenticcninentareatype) ; 


{ 

************************************************************************ 
*  * 


*  FURPOSE  * 

*  This  procedure  stores  the  parameters  associated  with  a  * 

*  particular  scenario  (i.e. ,  a  particular  edit  menu  set)  * 

*  to  be  stored  in  a  PACE  archive  file.  * 

*  * 


) 

VAR 

parans  :  record  CASE  Parameteraccess:  boolean  OF 

IFDE:  (ParameterStuff:  SavedPararosRecord; 

CoramentAreacCcmroentArealVpe)  * 

FALSE:  ( Cellinf o : ArchivedCellType) ; 

end; 

begin 

{  Write  the  parameters  into  the  first  (0th)  cell  location.  Ihe 
parameters  are  written  using  a  variant  record  format. 

Hie  routine  also  re-creates  the  indicated  archive  file, 
wiping  out  all  previous  data  in  the  file.  ) 
psrams. parameteraccess  :=  TRDE; 

SaveEditPararos (ertur,  @params.pararoeterstuff ) ; 
params.cccimentarea  :=  canment; 

See}c(AF,0)  ; 

params. parameteraccess  ;*=  FALSE; 
write(AF,params.CellInfo)  ; 
end; 


^  ****'*'********'*»*'X***'»  ■********•*****■»  •*iir*'***'>ir**'x*'******'****'!it***'***'3tr*******'***'*j 


procedure  RestoreArchiveParametersf'TAR  AF:  Archivefile;eptr:erneni:r7cr; 

VAR  comment:  conmencarsacype)  ; 
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{ 

*****************  **t^*******'*********^t'**ifciHt*^f**^t*'****jHt****'****illt****^r'***ifc 


* 

* 

* 

* 

* 

* 


PURPOSE 

Ihis  prooeduze  stores  the  parameters  assocdated  with  a 
particular  scenario  (i.e. ,  a  particular  edit  menu  set) 
to  be  loaded  fron  a  PACE  archive  file. 


* 

* 

* 

* 

* 

* 


************************************************************************ 


) 

VAR 

params-  :  record  CASE  Parameteraccess;  boolean  OF 

TRUE:  (ParameterStuff:  SavedParamsRecord; 

OcnnentArea:  CcninentArealVpe} ./ 

RAISE:  (CellInfo:ArchivedCellIVpe) ; 

end; 

begin 

{  Read  the  parameters  frcm  the  first  (0th)  cell  location.  The 
storage  is  used  as  a  placeholder  for  the  ccmment  field  and 
the  parameter  area.  } 
params.parameteraccess  FALSE; 
see}c(AF,0) ; 

read  (AF ,  params .  Cellinf o) ; 
params . parameteraccess  ;*  TRUE; 

RestoreEditParams  (qjtr,  @paranis.  ParameterStuff) ; 
canment  :»  params .  conmentarea ; 
end; 


(*************************************************************************** j 

procedure  ViewArchiveCcjnroent(VAR  AF;  Archivefile;VAR  ccaiment:ccramentarea1^^) ; 
{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Ihis  procedure  reads  the  textual  catment  area  associated  * 

*  with  an  archive  file.  * 

*  * 

*  * 


************************************************************************ 

} 

VAR 

params  ;  record  CASE  Parameteraccess:  boolean  OF 

TRUE:  (ParameterStuff:  SavedParamsRecord; 

QmiinentArea:CanientArea3Vpe) ; 

FALSE:  (CellInfo:ArchivedCallType) ; 

end; 

begin 

{  Read  the  parameters  fron  the  first  (0th)  cell  location.  Ihe 
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storage-  is-used-asi~a-^plac5ehold^  'for-  the.-conm^^  fi^d-and^  - 
the  parameter  area.  } 
params.pararoeteraccess  FAI2E; 
see)c(AF,0) ; 

read  (AF/params.  Cell  Info) ; 
params.parameteraccess  :=  TRUE; 
cxxment  parains.cxamnientarea; 
end; 


procedure  Viefc«fei^itsGannent(VaR  WF;  Weightsfile;VAR  ccrroent;aanmeritareaty^  ; 
{ 


★  ★ 

*  roRPOSE  * 

*  This  procedure  reads  the  textual  ccmment  area  associated  * 

*  with  a  wei^ts  file.  * 

it  it 

*  * 


) 


var 

wd  :  WeightsDatalVpe; 
begin 

read(WF,wd) ; 
camnent  :»  wi.canment; 
end; 


(*******★★**★***★**********★*******'***★*★******★*******★★*********★****★****  j 

procedure  Viev^2R0aiiment(VAR  AF;  file;VAR  ccramentzcxaranentareatype) ; 

{ 

itititititicicitititititiiititicititititititititicitititititititiciticicitititieitieitititititititiciticitititiciticicitieicicific'kit’kicitit’k 


it  * 

*  HJRPCSE  * 

*  Tiis  procedure  reads  the  textual  cannent  area  associated  * 

*  with  a  QR  set.  * 

*  * 

*  * 


***************************************************************************** 

) 

begin 

seek(AF,0) ; 

blockread(AF, canment,  1) ; 
end; 


(***★*★**★****★****** '***'***'**'*****'*****'*****W***'*******************'******'***J 
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procedure  AadIt!Queue(^jtx:aneru;?3tr;sa»em;s2R^emen(;^^  ; 


{ 


*  * 

*  PCJRPOSE  * 

*  Hiis  procedure  adds  the  scenario  parameters  associated  * 

*  with  an  edit  menu  to  the  batch  queue.  * 

*  * 

*  * 


) 

var 

filename  :  string; 

Source, AF  ;  ArchiveFile; 

i  :  integer; 

tenp  :  archivedcel  Itype ; 

dir  :  DirStr;  (*  as  defined  in  the  DCS  unit  *) 

name  :  NameStr; 
ext  :  ExtStr; 

q  :  batehqueueentryptr; 

begin 

{  get  the  name  of  the  arcdiive  file  and  a  camuent  using  the  save  menu  } 

filename  :*  SM2nu^.FileButton.Text_String; 

fsplit(filename, dir, name, ext) ; 

fUenane  :»  name  +  ext; 

if  filename  »  "  then 

begin 

messagebox.displaymessage((GetMaxX  DIV  2)  - 

(textwidth( 'Please  Select  An  Appropriate  Filename  before  queueing. . . ')  DIV  2) , 
GetMaxI  DIV  2,1, 

length  ('Please  Select  An  ^rproprlate  Filename  before  queueing...') 

,  li^tred,  white, 

'Please  Select  An  ^prcpriate  Filename  before  queueing, . . ') ; 

be^; 

messagewait; 
messagebox .  hidemessage ; 
end 
else 
begin 
new(q)  ; 

SMenn''.MaioBox.AssignC2iangedrext(q^.CcsniientArea) ; 
messagebox. displaymessage(  (GetMaxX  DIV  2)  - 

(textwidth( 'Archive  will  be  saved  to  file:  'H-ARCHIVEPAIHr' 
(GetMaxY  DIV  2)  -  (textheight('l')  DIV  2), 

1, 

length  ('Archive  will  be  saved  to  file:  '-ARC'iIVE?AI&-'\'-f 

lightred, 

white, 

'Archive  will  be  saved  to  file:  'r-AI^ITVEPAIH+'X'-rfilename 
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Delay  (2000).;. 

(  save  the  edit  parameters  ) 

SaveEditRgams  .parameterstuff ) ; 

q^. filename  filename; 

{  put  the  info  into  the  queue  linked  list  for  later  processing  ) 
q^'.next  :=  NIL; 

IF  topofbatchgueue  »  NIL  THEIT 
begin 

tcpofbat:±queue  :=  q; 
batcdiqueue  q; 
end 

FTgR 

batchqueue<'.next. 

;*  q; 

messagebcK.hidemessage ; 

HideODntext; 

CanoelContext; 

end; 

end; 

(**★*★****★★********★************★★•**★*★*★*********★****★★******★******★****) 
procedure  QueueAction; 

{ 

**★★*★**★*★★*****★★**★*★★★****★★******★***★**★**★***************★******* 


★ 

* 

* 

* 

* 

* 


HIRPOSE 

Uiis  procedure  obtains  the 
be  associated  with  a  batch 


★ 

★ 

scenario  archive  information  to  * 
scenario.  * 

* 

* 


***********************************  ********  ******************************** 

) 

var 

savecanment;  canroentareatype; 


begin 

{  pep  up  the  save  window  to  get  the  file  name  and  ccroment  } 
(^leueSaveMenuWindcvr . FileButton. ChangejString  ( " ) ; 
QueueSav^fexmWindcfcr.MemoBox.GetNewText(QueueSaveCcrnment) ; 
pushccritext('queuemenuwindow') ; 
showcontext; 

end; 


(****************************#**********************************************) 
prxedure  auxQueueAction; 

{ 


************************************************************************ 
*  * 

*  PURPOSE  * 

*  Ihis  procedure  obtains  ohe  scenario  archive  information  to  * 

*  be  associated  with  a  batch  sc:anario.  * 


F-272 


File  Name:  EKXS.PAS 


*  * 

*  * 

*********************  jlr***'*********'*************^^****  ********************** 

) 

var 

saveccranent:  oannentareatype; 
begin 

{  pep  t:p  the  save  window  to  get  the  file  name  and  ccpunent  } 
AiwQueieSaveMenuWindc^ .  FileButton.  ChangejString  ( " ) ; 
i^uxQueueSavdMenuWindcw^.MenoBax.GetNeMText(QueueSaveCctiiment) ; 
pusha3ntext(^auxgueuemenuwindcw<} ; 
showcontext; 

end; 

(^*-k*it*iti!rk**it****'it***itit**it*-k*it******-k*******irk*-k**it**irit**-k*******************'^ 

procedure  queuesaveAction; 

{ 

***********************************•>************************************ 


* 

* 

* 

* 

★ 

* 


* 

PURPOSE  * 

This  procedure  invokes  the  save  to  batch  queue  routine  for  * 
the  left  split  and  main  cell  displays.  * 

* 
•k 

) 

begin 

AddToQueue  ( editmenu ,  QueueSaveMeni:^indow) ; 
end; 

^  *****************************************************************************  j 

procedure  auxgueuesaveAction; 

{ 

************************************************************************ 


* 

* 

* 

* 

* 

•k 


k 

HJRPOSE  * 

Uiis  procedure  invokes  the  save  to  batch  queue  routine  for  * 
the  left  split  call  display.  * 

* 

★ 


***********************************************  k’kkrkirL'ickicitkickititkkkiek'kkkititkie 

} 

begin 

AddToQueue  ( auxeditmenu ,  AuxQueueSav^fenuWindow)  ; 
end; 

^  *******************************************  ********************************  ^ 
procedure  processbaochoueue; 

{ 

kkkirkkkkkkk'kkiekk'Stit'kk'k'k'k'kkk'^frk'kkitkk'kk'k'k'kkk-k'kitvtic'k'kikk'x'kk'xiek'k'xk-k'kk'ic'k^-k'k'x-x-kierKvc 
•k  k 
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*  HIRPOSE^'  * 

*  Hus  procediTO  causes  all  scenarios  in  the  batdl  queue  to  * 

*  be  processed  and  stored  in  archive  files  vhen  finished  vAien* 

*  invoked  fron  the  left  ^lit  or  main  cell  di^lay.  * 

*  * 

} 

VAR 

tenp,tenp2:  batchqueueentryptr; 
i,xx,yy:  integer; 

AF:  ArchiveFile; 
t:  archivedcelltype;- 
begin 

tenp  :»  topofbatchgueue; 
get_cursorxy(30c,yy) ; 
hidecontext; 
pcpcontext; 

HiliteConte)ct(xx,yy)  ; 

WHILE  tenp  o  NIL  DO 
begin 

IF  ri^te^qandei  THEN 
begin 

RestoreEditParags  (auxeditmem^  gteap^ .  parameterstuf f ) ; 
rl^tSaveCcniment  :*  tenp^.canmentarea; 
ri^itlowerStatus'' .An±iveFile  :»  tenp^, filename; 
ri^tlcwerstatus^ .  show; 

ConputePsa(auxeditmenu,ri^tlowerstatus) ; 
end 
ELSE 
begin 

RestoreEditParaiiB(editinenu,@tarr?y'. parameterstuf f) ; 

LeftSaveOanment  :*  tenp^.ccoanentarea; 

LeftIcwerStatus'' .ArchiveFile  :=  temp^. filename; 
leftlcwerstatus^ .  show; 

CaroutePsa  ( editmenu,  leftlcwerstatus) ; 
end; 

IF  rightexpanded  IHEN 
begin 

rethresholdcells(BIGCellGrid,auxeditmenu,rightlowerstatus) ; 
BigCellQrid^  .Show; 

Bic^lap'' .SHCW; 
richtlcwerstacus'' .  shew ; 
end 
ELSE 
begin 

IF  lefte:q»nded  THEN 

rethresholdcells  (BIGCellGrid,  editmenu,  leftlowersratus) 

ELSE 

rethresholdcells  (LeftCallGrid,  editmenu,  leftlcwerstatus) ; 
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IF  "leftlSqsanded  THEN 
begin 

BigCellGrid-' .  Shew; 

BigMc^  .SHCW; 
end 
ELSE 
begin 

LeftCellGrid^  .Shew; 

IfiftMap^.SHCW; 

end; 

leftlcwerstatus'' .  shew; 
end; 

{  new-' save^  the  scenario  } 

IF  ri^texpanded  THEN 
begin 

Assign(AF,ARCHIVEPA3H  +  +  ri^tlewerstatus''.arciuvefile) ; 

Reset  (AF) ; 

SaveArchivePararoeters  (AF,  auxeditmenu, tertp^ . cxsnmentarea) ; 
Close  (AF) ; 
end 
ELSE 
begin 

Assign(AF,ARC3irVEPAIH  +  *y  +  leftlcwerstatus''.archivefile) ; 
Reset  (AF)  ; 

SaveArciuvePara]iete3:s(AF,editinenu,tenp^.cx3imentarea) ; 

Close  (AF) ; 
end; 


tenp  ;=  Teirp''.next; 
end; 

(  clean  up  the  linked  list  } 
tenp  :=  tcpofbatchqueue; 
WHUE  tenip  o  NIL  DO 
begin 

teinp2  :=  tenp^.next; 
dispose  (tenro) ; 
teitp  :=  tenp2; 
end; 

tepofbatciiqueue  ;=  nil; 
end; 


procedure  auxprccessbatchqueue; 

{ 

**'*****'>t*****'********w*-*  •****★*■*  ■***^t****'*'>ciitiitx*i(7f**it**'jr7t******'*?ir*»r******** 
*  * 
*  HjRPOSE  * 
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Ihis  5axx»dure^,causes«.aH- scenariosi^iiv  theKbatA-queue<'to  * 
be  processed  and  stored  in  archive  fil^  when  finish^  wh^* 
invcJced  fron  the  ri^it  ^lit  cell  display.  * 

* 

} 

VKR 

tenp,tenp2:  batchqueueentryptr; 
i/XX,yy:  integer; 

AF;  ArchiveFile; 
t:  arcfaivedcelltype ; 
begin 

tenp  :«  topofbatchqueue;.- 
get_cursorxy(x>c,yy) ; 
hidecontejct; 
pcpcontext; 

HiliteContext(x5C,yy) ; 

WHILE  teirp  o  NIL  DO 
begin 

RestoreEditParains(auxeditmenu, etenir  .parameterstuff )  ; 

ri^itSaveOaranent  tenp^.ccanmentarea; 

rightLcwerStatus^ .ArchiveFile  :»  tsnp^. filename ; 

rightlowerstatus''  .show; 

aatputePsa(auxeditinenu,ri^tlowerstata:is) ; 

rethresholdcell, s  (rie^tCellGrid^ auxeditmenu^ ri^rtiLowerstatus) ; 

ric^tCellGrid^  .Show; 

rightMap^  .SHCW; 

rightlowerstatus'' .  shew; 

{  now  save  the  scenario  ) 

Assign (AF,ARaiIVEPAIH  +  +  rightlcwerstatus^ .  archivef ile) ; 

Reset  (AF) ; 

SaveArchiveParameters(AF,aux€.ditmenu,tenp^.cornmentarea) ; 

Close  (AF) ; 

tenp  :=  Tency'.next; 
end; 

{  clean  up  the  linked  list  ) 
tenp  ;=  topofbatchqueue; 
tenp2  :=  tcpofbatchqueue; 

WHILE  teap  o  NIL  CO 
begin 

taro2  :=  tenp^.next; 
dispose (tenp) ; 
tenp  :=  te!ip2; 
end; 

tcpofbatchqueue  ;=  nil; 
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procedure  editsneniprocess; 

{ 


* 

★ 

* 

* 

* 

* 


* 

HJRPOSE  * 

This  procedure  causes  the  scenario  that  has  been  set  i^3  in  * 
the  main  or  left  split  screen  cell  display  to  be  processed.* 

* 

* 


************************************************************************* 


} 

VftR 

XX,  YY:  integer; 
begin 

HideContext;  PcpContext;  {  don't  use  cancel  context  here  because  the 

emenu  cancel  restores  the  edit  params  from 
the  previous  set  } 

CancelContext; 

Get_CursorXY(XX,YY) ; 

HiliteOontext(XX,YY) ; 
leftsidestatus'^ .  shew; 

IF  (editiDenu''.recaipite)  OR  (LeftIj:werStatus''.archivefile  =  ")  THEN 
begin 

LeftlowerStatus^ . AndiiveFile  ;*  IJEFn3EFmiI3iRCI[IV^ 
leftlcwerstatus'' .  show; 

CcppitePsa(editinenu,leftlcwerstatus) ; 
end 
else 

leftlcwerstatus'' .  shew; 


{  IF  we  are  re-thresholding  an  alreacfy  loaded  archive,  then 
use  that  art±d.ve  nasse.  Else,  use  the  default  archive.  If  there 
is  NO  ardiive  because  we  have  not  loaded  any  and  we  have 
not  yet  performed  a  Psa  calulation  since  starting  pace, 

then  create  exje  using  the  tenporary  archive  file.  ) 

IF  leftexpanded  THEN 

rethresholdcells  ( BIGCellGrid ,  editmenu ,  leftlcwerstatus ) 

ELSE 

rethresholdcells (leftCellGrid, editmenu, leftlcwerstatus) ; 

IF  LeftEaDanJed  THEN 
begin 

BigCellQrid^ .  Shew ; 

BigMap^.SKCW; 

end 

ELSE 

begin 

LeftCellGrid''  .Shew; 
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LeftMap^.SIKW; 

end; 

leftlc3wersta.tus^  .shew; 
end; 


procedure  aujffiditmemprocess; 

{ 


*  * 

*  HJRPOSE‘  * 

*  Uiis^  procedure:  .causes<?.the  .scjenario  that  has'-been  set  in  * 

*  the  ri^t  split  screen  cell  di^lay  to  be-prooessed.  * 

*  * 

*  * 


**************★**★*★**★*★***★★***★*******★*****★*★**★******★*★★****★**★* 

} 

VKR 

XX,YY:integer; 

begin 

HideOontaxt;  PqpContext;  {  don^t  use  cancelcontext  here  because  the 

emenu  cancel  restores  the  edit  params  from 
the  previous  set  ) 

CajTcelContext; 

Get_QarsorXy(XX,YY) ; 

HiliteContext(XX,YY) ; 
rightsidestatus'' .  shew; 

{  load  up  the  process  from  the  right  edit  menu  ) 

IF  (auxe^tmenu^.recenpite)  OR 

(RL^tLswerStatus''.archivefile  =  ")  THEN 

begin 

RightLcwerStatus'^  .ArchiveFile  :=  RICSODEFAULIARCHIVE ; 
rightlowerstatus'' .  shew; 

OaiputePsa(auxeditinenu,ri^tlcwerstatus) ; 
end 
else 

rightlowerstatus'' .  shew; 

{  IF  we  are  re-thresholding  an  alreac^  loaded  archive,  then 
use  that  archive  name.  Else,  use  the  default  archive.  If  there 
is  NO  archive  because  we  have  not  leaded  any  and  we  have 
net  yet  performed  a  Psa  calulation  sinca  starting  pacs, 
then  (create  one  using  the  tenporary  archive  file.  ) 

IF  ri<htejpanded  THEN 

rethresholdcalls  (BIGCell(3rid,  auxeditme-nu,  rightiewerstatus) 

ELSE 

rethreshol(2cells  (RightCellGrid ,  auxeditmenu ,  rightlcwerstatus ) ; 

IF  RightExpanded  THEN 
begin 
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BigCellGrid^  .Shew; 
Bic^Is^j^.SHCW; 
end 
ELSE 
begin 

Ri^tCellGrid''  .Shew; 
RightMc^  .SHCW; 
end; 

ri^tlowerstatus'' .  shew; 
end; 


^  ******************************************************************************  j 


procedure  ShcwCellData(selfptr;  CellPtr) ; 

{ 

****it**'/it*******************  ********************************************* 


*  * 

*  HJRPOSE  * 

*  Utility  routine  to  display  the  appropriate  colors  for  a  * 

*  cell.  Gets  bound  to  all  cells  in  the  cell  grid  object.  * 

*  * 

*  * 


************************************************************************ 

) 


var 

XX,  yy  :  integer; 


begin 

Get_CursorXy(x>£,yy) ; 

Hide__Cursor; 

if  selfptr'.IsHilited  then 
selfptr'  .SetHilite  (False) 

else 

begin 

if  selfpcr'.IsAbovelhreshold  tnen 

selfptr'. color  ;=  selfpar'.abovecolor 
else 

selfptr'. color  :=  selfptr'. belewcolor; 
setf ill^le  ( solidf ill ,  selfptr .  color)  ; 
bar  (selQitr' .X, 
selfptr^. Y, 
selfotr'.X  + 
selfptr'.  Width, 
selfptr^.y-f- 
selfptr^. Heii^o) ; 

end; 

setcolor( selfptr. EorderColor) ; 

setlinestyle  ( solidln ,  0 ,  rxsrnwidth) ; 
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rerjt  sngle<sel:Qjt2^  .x> 
selj^ter'.y, 
selfptr^.x  + 
selfptr' .width, 
selfptr^.y  + 
selfptr^  .Height) ; 
Shcw_Cursor(xx,yy) ; 
end; 


(******************************* *■**★**★*****************************★★******) 


prooedtare  DrawCells ,  jelfptrt  CellPtr) ; 

{ 

************************************************************************ 


*  * 

*  HMOSE  * 

*  Utility  routine  to  display  the  appropriate  colors  for  a  * 

*  cell  for  the  weights  editor.  * 

*  * 

*  * 


*★****★★*  **********iit********i»*******;k***iit****************rt************iit* 

} 


begin 

setcolor  ( selfptr^ .  BorderColor ) ; 
setlinestyle (solidln,  0 ,  nonnwidth) ; 
rectangle(selfptr'.x,  selfptr'.y, 

selfptr'.x  +  selfptir  .width,  selfptr^.y  +  selQrtor' .Height) ; 
ShcwWeightsCel  IData  ( selfptr ) ; 
end; 


(****************************************'******************ii(************'****j 

procedure  Shcx.rfWei^tsCellData (selfptr:  CellPtr); 

{ 

■***★**■*******  ilt**'5lf»f*********'***'*******5fc************1***'»t****************»tli( 


*  * 

*  HJPPCSE  * 

*  Utility  routine  to  di^lay  the  appropriate  wei^t  for  a  * 

*  cell  for  the  wei<^ts  editor.  * 

* 

*  * 


} 

var 

XX, yy  :  integer; 
tap  :  string; 
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begin 

GetjCursorX5f  (xx, yy) ; 

HidejCursor; 

STR(selJ^Jtr^ . Wei^t_or_Coverage:  2 ,  tnp)  ; 
settextstyle(smallfc3nt,hca:i2dir,4) ; 
setcolor(Yellc3w) ; 

settextjustify(csntertext,c»nterte^  ; 
out±extxy(selfptr''.X  +  (selfptr^. Width  DIV  2), 

selfptr^.Y  +  (selfptr^ .Hei(^t  DIV  2),  titp) ; 
settextstyle(defaultfc3nt,hori2dir,l)  ; 

IF  NOT  WeightCellGrld^  .picklngwei^hts  TEIEN 
IF  sel^Jtr^. region  IHEN 
selfptir .  shcwregion 
ELSE 

selfptr'  .hideregion; 

Shcw_Cursor(xx,yy) ; 
end; 


( ************************ ,  ****************************************************  j 

procedure  ShowCoverageCellData  (selfptr:  CellPtr) ; 

{ 


★  * 

*  PURPOSE  * 

*  Utility  routine  to  display  the  appropriate  color  for  a  * 

*  cell  for  the  coverage  display.  * 

*  * 

*  * 


) 

VAR 

XX, yy:  integer; 
begin 

{  get  the  database  data  for  each  cell  and  color  it  appropriately. 

The  coloring  scheme  is  as  follows: 

SNR  -  red 

S/L  ratio  -  licht  red 
Modal  -  M  in  the  cell  center 
XAngle  -  X  across  the  cell 

The  various  object  variables  associated  with  a  call  type  variable  are 
used  to  hold  flags  that  indicate  the  condition  of  the  above  threshold 
tests.  These  are  related  as  follows: 

selfptr'. abcvecolcr  -  SNR  or  S/L  color  (red  or  li^t  red  or  blue  of  OK) 

selfptr^. belcwcoior  -  0  if  not  modal,  modal 

selfptr'. weight  or  coveirage  -  0  if  Xangle  OK,  else  not  OK 
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Get_CursorXy{xx,yy) ; 

Hiciejilirsca:; 

setcolor(selQ3tr^.BorcaerColor)  ; 
setlineslg^le (solidln,  0 , nonawidth) ; 
rectangle(selQjtr' .X, 
selfptr^.y, 
selQitx^.x  + 
selfptr^.vd.dt±i, 
selfptr^.y  + 
selfptr*'. Height)  ; 

setfillstyle(solidf ill ,  selfptx^ .  abovecxslor) ; 
bar  (selfptr^  .X+1, 
selfptr'.y+l, 
selfptr'.X  + 
selfptr^ .  Width-1 , 
selfptr'.Y+ 
sel^rtar'. Height-1) ; 

IF  selfptr^.wei^t__or_coverage  o  0  THEN 
begin 

setcolor  (black) ; 

line  ( selfptr^ .  xf  1 ,  selfptr^ .  y+i , 

selfptr^.x4«elfpter. width-1, selfptr^.y+selfptr'. height-1) ; 
line  ( selfptr' .  x+selQjtr^ .  width-1 ,  selfptr' .  yf  1 , 
selfptr^.x+l,selfptr^.y+selQjtr'. height-1) ; 

end; 

IF  sel^ptir  .belowcolor  o  0  THEN 
begin 

setcolor  (white) ; 

settextjustify(centertext,tcptext) ; 
cuttextxy (selfptr^. x^^elfptr^. width  DIV  2, 
selfptr'. y+selfptr'.hei^t  DIV  2, 

'M'); 

end; 

Shcw_Cursor(xx,yy)  ; 
end; 


^***************************************************************************j 


procedure  CellAction(cellnuniber:  integer; 

Krtrremenuptr;  archivename:  string) ; 


{ 


*********x*********:»*********7ir************'*****x************************ 


*  * 

*  roRPCSE  * 

*  Procedure  to  build  and  display  the  tenporal  (hour/month)  * 

*  display  of  the  suirarary  cell  query  display.  * 
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} 


var 

erxarstring  :  string; 
inon,hr, nmth, hour:  integer ; 
cellstuff:  archivedcelltype; 

AF:  Archivefile; 
begin 

{  First  espy  the  cell  info  into  the  global  info  areas. 

Next,  reach  into  the  archive  file  and  pull  out  the  info 
for  the  particular  cell  in  question  and  fill  in  the 
cells  of  the  CellPcpWindcw  object.  } 

{  Open  up  the  archive  file  indicated  and  get  the  Pa  values 
for  each  hour, and  the  coverage  for  each  hour  also.  Check  the 
archive  name  and,  if  it  is  null,  do  not  pep  up  the  info  windew. ) 

IF  archivename  o  ••  THEN 
begin 

Assign (AF,ARCNIVEPAIH4-'\'+archivename)  ; 

Reset  (AF) ; 

IradCe-llFrcniArchive  (AF,  cellnuniber,  cellstuff) ; 

Close  (AF)  ; 

KSR  month  :=  1  TO  12  DO 
FOR  hour  :=  1  TO  24  DO 
begin 

CellPcpup^.subcells[month,hour] .Pac  ;=  Cellstuff [month,hour]  .Pat; 
CellPcpup^ .  subcells  (month ,  hour] .  Weight__or_coverage  :  *= 

Cellstuff  [manth,hcur]  .coverage; 

IF  Cellstuff  [month,  hour]  .Pat  <  Krtr'.Psa.  Value.  Value  THEN 
CellPcpup^ .  subcells  [month ,  hour] .  abcvethreshold  :  =  FALSE 
ELSE 

CellPcpup^ .  subcells  [month,  hour] .  abovethreshold  :=  TRUE  ; 

end; 


for  men  ;=  1  to  12  do 
for  hr  :=  1  to  24  do 


with  CallPou^Jp^  do  begin 

SufaCeils[roon,hr]  .ChangeXy(X  xoffset  + 

( (mon-l)  *  cellwidth) 


end; 


Y  +  yoffset 
( (hr-i)  *  cellheight) 
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CellJtipOp'^CellNum  :*  ceUnunfcer; 

OellBof3C3J>^.epta:  :*  eptx; 

PushCorrtextC'CellPopUp^) ; 

ShowOontext; 

end 

else  begin 

messagdxK.displayini3ssage( (GetMaxX  DIV  2)  -  (textwidth('JUrciiive  File  Not  Loaded...') 

(GetMajtf  DIV  2)  -  (textheight('l') ) , 

1, 

length  ('Archive  File  Not  Loaded. . . ')  / 

lightred> 

white, 

( 'Archive -File  -Not  :Load<^: 

beepr 

messagewait; 
messageboQC .  hidemessage ; 

CellPopUtr  .HilitedCellPtr' .  Cancel ; 
end; 
end; 


procedure  RightCellGridAction  (salfptr  :  CellPtr;  cellnunher:  integer) ; 
{ 


★  * 

*  PORPOSE  * 

*  Procedure  to  set  up  for  a  summary  cell  display  using  cell  * 

*  action  procedure  for  the  right  split  cell  grid  display.  * 

*  * 

*  * 


*****************  *************'************<riHt********:^A********yt*****ilr** 

) 

const 

WindowOffset  »  10;  (*  distance  between  the  cell  and  the  windcw  edge  *) 

var 

men,  hr,  xx,  yy  ;  integer; 


begin 

Get_CursorXy(xx,iy) ; 
selfptr'.Hilite(xx,yy) ; 
with  RightCellQrid^  do  begin 

if  (CellArray[cellnuit!ber3  .X  <  (GetMaxX  "  RightSideftatus'' .-^dth  - 
CellArray[cellnui±er3  .width  - 

CellPopQp''. Width  -  WindowOffset  -  WindewShadewWidth)  )  then 
CellPcpOp^.X  :=  CeUArrayfcsllnunrer] .X  + 

CellAcray^cellnuiQberJ.Widch  -s' 
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V7indoM3ffset 


else 

CellPcjpD^.X  ;*  CellAnay[ce.llnuniber3  .X  - 

CellBspC^. Width  - 
WindowOffset? 

end; 

CellPopU^ .HilitedCellPtr  :==  @RL^CellGrid^.CellArray[cellnuiiiber] ; 
rol  1  ar;h-i am (Qell nimfcp.r^ auxpdi tiTiP-rni^ cwerstatus^ . arthivef lie)  ; 
end; 


(*********************■*********★**********************************★*********) 
jHXX3edure  •IeftCellGridAction(seli5rt3r  :  CellPtr;  cellnunber;  integer) ; 

{ 


* 

* 

* 

* 

* 

* 


HJPPOSE 

Procedure  to  set  vp  for  a  summary  cell  di^lay  using  cell 
action  procedure  for  the  left  split  cell  grid  display. 


* 

* 

* 

* 

* 

* 


***★***********★**********************'*********★*************★***■******* 


const 

WindowOffset  *  10;  (*  distance  between  the  cell  and  the  window  edge  *) 


var 

man,  hr,xx,yy  ;  integer; 
begin 

Get_CursorXY(xx,yy) ; 
selQ:tr'.Hilite(xx,yy)  ; 
with  LeftCellGrid''  do  begin 

if  (CellAtxay[cellnuniber]  .X  <  (GetMaxX  -  Righ*:SideStatus'^.width 
CelliSaxay[cellnuinber]  .Width  - 

CellPcpUp'. Width  -  WindowOffset  -  WindcwSliadowWidth)  )  then 
CellPcpUp^.X  :=  CellArray[cellnumber] .X  + 

CellArray[cellnumber3  .Width  + 

WindowOffset 

else 

CellPcpOp^.X  ;=  Cellftrray[cellnumber]  .X  - 
CellPqpUp^. Width  - 
WindcwOffret; 

and; 

CellPcpCJp^.HilitedCellPtr  :==  §IjeftCellGrid^.CsllArray[ceilnuinber] ; 
CallAction  ( cellnumber ,  editmenu ,  leftlowerstatus'' .  archivef ile) ; 
end; 


^  **lr*i*****'JWfife'*'3t*'***!*'**'>'r'*«'*'*'***5tx***'**'*'****':i(  *iik*'***'*******x*******'*;ft****'*****x'*  J 
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procedure  BigCellGridAction(selQrta:  ;  CellPtr;  cellnunber: integer) ; 

{ 


* 

HJRPOSE  * 

ProcecJure  to  set  ip  for  a  summary  cell  display  using  cell  * 
action  procedure  for  the  main  cell  grid  display.  * 

* 

* 


) 

(*  Cell  Action  defines, the  action  to  occur  .vihen  either  the  .<ENrER>.  key  *) 
(*  or  the  <LEFT  MOUSE  Et7rrCN>  is  hit  in  full-screen  mode  or  vten  the  *) 
(*  cursor  XY  position  is  over  the  left  map  in  split-screen  mode.  *) 
(*  Ciis  procedure  will  determine  the  X  coordinate  for  the  *) 
(*  CellPcpUp  window  (the  Y  coordinate  stays  fixed  because  the  window  *) 
(*  extends  from  the  map  top  to  the  map  bottom)  and  will  display  the  *) 
(*  pop  iqp  window.  *) 


const 

WindovOffset 


10;  (*  distance  between  the  cell  and  the  window  edge  *) 


var 

mon,  hr,»c,yy  :  integer; 


begin 

Get_CursorXY(xx,yy) ; 
selfptr'.Hilite(xx,yy) ; 
with  BigCellGrid^  do  begin 

if  (CellArray[cellrwmber] .X  <  (GetMaxX  -  RightSideStatus''. width  - 
CellArrayicellnumber] .Width  -  Cea.lPopUp^. Width  - 
WindowOffset-WindcwShadowWidth)  )  then 
CellPcpt^.X  :=  CellArray[cellnumber]  .X  + 

CellArray  [  cellnumfaer  ]  .Width  + 

WindowOffset 

else 

CellPcpUp^. X  :=  Cell  Array  [cel  Inumber]  .X  - 
CellPcpI^ .  Width  - 
WindowOffset; 

end; 

CellPcpUp^ .HilitedCellPtr  :=  QBigCellGrid''. CellArray [ cellnumber ] ; 

IF  leftexpanded  THEN 

CellAction  (cellnumber,  editnenu,  leftlowerstatus'' .  art±dvefile) 

ELSE  {  right  e^gsanded  } 

CellAction  (cellnumber ,  auxeditrenu ,  ri^tlcwerstatus'' .  araiivefile) 

end; 
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^****************'***********************'******************jc****.********'*****) 


procedure  SubCfellAction(selfptr  :  CellPtr;  cellnumber:  integer) ; 


{ 


*  * 

*  RIRPOSE  * 

*  Procedure  to  di^lay  the  detailed  cell  query  viien  a  query  * 

*  on  the-'sunnary  cell  query  display,  is  performed.  * 

*  * 

*  * 


************************************************************************ 


) 

const 

WindcwOffset  *=  10; 

BottarWindofcXDffset  *  110;  (*for  vertical  positioning  *) 
BcttOEWindcwPosition  ®=  50;  (*add  to  top  window  Y  position  to  determine  *) 

(*the  Y  position  for  the  botton  window  *) 


var  XX, yy  :  integer; 
begin 

get_cursor:^(xx,y7) ; 
selfptr'.Hilite(xx,yy) ; 

with  CellPopCJp^  do  begin 

if  (SubCells[!tonth,Hciur]  .X  <  (GetMaxX  -  Ri^tSideStatus'^  .width  - 
SubCfells(Month, Hour]  .Width  -  SubCellPopUp*  .Width  - 
WindcwOffset-WindcwShadcwWidth)  )  then 
begin 

(*  put  pcp-cp  window  to  the  RiaiT  of  the  selected  cell  *) 
SubCellPopUp^.X  :»  SubCells[Month,Hour]  .X  + 

SubCells  [Month,  Hour]  .Width  + 

WindcwOffset; 

SubCallPcpC^.BottcmMenu.X  :=  SubCellPcpUp^.X; 
end 
else 
begin 

(*  put  pop^  window  to  the  LEFT  of  the  selected  cell  *) 
SubCellPopUp'.X  :=  Sv±Cells[Month,Hour] .X  - 

SubCellRpOp^. Width  - 
WindcwOffset; 

SubCellltpUp^.BottcnMenu.X  :=  SubCellPcpOp^.X; 
aid; 


if  ((SubCells[Month,Hcur].Y-'Sui:CellsrMcnth, Hour]  .Height-^ 

BottcaWindcwOffset)  <  (GetMaxY  -  LeftLowerStatus-' .Height  - 
SubCel  IPcpUp^  ♦  Height  -  WindowOffset-WindowShadcwWidth)  )  then 
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be^m 

(*  put  pcfM?)  window  BEICW  the  select^  cell  *), 
SubCellPop^p^.y  :=  SubCells[Month,Hour].y  + 

SubCells[Month,Hour].Heic^t  + 

WlndowOffset; 

.  SubCellPopUp^.Bottar^^  :*  SubCellBcpl^.Y  +  BottcrWindcwPosition; 
end 
else 
begin 

(*  ^put-^pop-ip'wiixaev-ABOVE  the  selected 'cell  *)‘ 
SubCellPcpD|)^.Y  :*  SubCells[M3ntii,Hbur.].Y  ~  ^SubGellJPoiX^p^,. Height  - 

BottcnWindowOffset.  7  ‘Windci«X)ffset 

c!iiW!ftT'i ivitrtjitMenu^v  :*  SubCeliPcpi^.Y  +  BottcuWindowPosition; 
end; 

if  SubCellPqsUp^.Y  <  (qp.Y  +  q^.Height  -r  Windc»iOffset)  then 
begin 

SubCellPopUp^  Y  ;»  (q^.Y  +  g^. Height  +  Windcu^ffset) ; 

SubCellPopC^ .BottccMenu.Y  :*  SubCellPopUp^.Y  BottcartWindowPosition; 
end; 
end; 

PushContext('SubCeJ.lPopCp^) ; 

ShcwContext; 


eixi; 


Procedure  !uxhivemenuvd€w(liienu:ljner^ 
{ 


*  * 

*  HJRPOSE  * 

*  Procedure  to  display  the  coument  associated  with  an  * 

*  archived  scenario  file,  * 

*  * 

*  * 


************************************************************************ 

} 

VAR 

errorstring  :  string; 
ten^string;  conmentareatype; 

AF:  Archivefile; 
begin 

IF  Iroenu^ .  directorylist .  picked  >  0  IHQT 
begin  {  read  the  stuff  in  } 

Assign(AF,ARCHr7EPA33H-'\'+lmenu''.selectadfile) ; 

Reset  (AF)  ; 
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ViewArchiveCcninent  (AF ,  tenpstring) ; 

Close (AF) ; 

messageboK.displaymessage((GetMaxX  DIV  2)  -  (25*textwldth('  ')), 

GetMaxY  DIV  2, 

5,50,cyan,bladc,ten|string) ; 

messagewait; 
messagdxsc.hidemessage ; 
end 
ELSE 
begin 

messageboK.displayroessage(  (GetMaxX  DIV  2)  - 
(textwic3th('File  Not  Selected')  DIV  2) , 

GetMeOiY  DIV  2,1, 

length  ( 'File  .Not  Selected' ) ,  li^tred,  white , 

'File  Not  Selected') ; 

be^; 

messagewait; 
messagebox.hidemessage ; 
end; 
end; 


Procedure  QE?menuview(lmenu;lmenuptr) ; 

{ 

!ft*ifc**^********************illr**ifr***  ***************************************** 


*  * 

*  HJRPOSE  * 

*  Procedure  to  display  the  canment  associated  with  a  * 

*  C2R  set  file.  * 

*  * 

*  * 


ifkitit***it*******-ii*ic*******it*ii*****ifkitirk**ii**irk****it**-k*********ii*it******* 

} 

VAR 

teitpstring:  conmentareatype; 

AF;  file; 
begin 

IF  Imenu-'.directorylist. picked  >  0  IHEN 
begin  {  read  the  stuff  in  } 

Assign (AF,QRPAIIH+'\'+lmenu''.selectedfile) ; 

Reset (AF,Si2eof(ccniiientareatype) ) ; 

ViewQRConment  (AF ,  tenpstring)  ; 
acse(AF)  ; 

messagebox.displaymessage((GetMaxX  DIV  2)  ~  (25*texon.dth('  ')), 

GetMaxY  DIV  2, 

5,50,cyan,black,tenpstring)  ; 

messagewait; 
messagebox.  hidemessage ; 
end 
ELSE 
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begin 

messagebcoc.displaymessage(  (GetMaxX  DP/  2}  > 
(te)ctwidtii('File  Not  Selected')  DIV  2) , 
GetMaxY  DIV  2,1, 

length('File  Not  Selected')  ,lightred,T^Mte, 
'File  Not  Selected') ; 

beep; 

messagewait; 

messagebox.hidemessage; 

end; 

end; 


procedure  listmenuview; 

{ 


*  * 

*  RJRPOSE  * 

*  Procedure  to  display  the  ccnment  associated  with  an  * 

*  archive  file  for  the  left  split  and  main  cell  displays.  * 

*  * 

*  * 


************************************************************************ 

} 

begin 

archivemeriuview(listiiienu) ; 
end; 


procedure  rightlistmenuview; 

{ 


*  * 

*  PURPOSE  * 

*  Procedure  to  display  the  ccanment  associated  with  an  * 

*  archive  file  for  the  ri^t  split  cell  display.  * 

*  * 

*  * 


**************'*********************i(f**ilr*********'**************v*****»t*** 

) 

begin 

archiveanenuview  ( ri^tlistmenu) ; 
end; 


procedure  reliabilitymenuview; 

{ 

*************************'***'»t*'***'*****»r***»************-sit***********'**7f*'* 


*  * 

*  FJRPCSE  * 

*  Procedure  to  display  the  canment  associated  with  an  * 

*  QR  set  file  for  the  left  and  min  cell  display.  * 
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*  * 

*  * 

Ik*********************************************************************** 

} 

begin 

QRnaTuview(reliabilitylistinenu)  ; 
end; 


procedure  auxreliabilityinenuview; 

{ 

************************************************************************ 


*  * 

*  raRPOSE  * 

*  Procedure  tx)  display  the  canment  associated  with  an  * 

*  set  file  for  the  ri^t  cell  display.  * 

*  * 

*  * 


} 

begin 

QRmenuview(auxreliabilitylistinenu) ; 
end; 


(******************************iit********************************************j 


procedure  listaenuaction; 

{ 

it  * 

*  PCJRPOSE  * 

*  Procedure  to  get  the  name  of  the  archive  file  to  be  loaded  * 

*  and  to  perform  the  actions  necessary  to  lead  the  info  into  * 

*  the  left  and  main  cell  grid  displays.  * 

*  * 
*********************************************************  ****************** 


} 

VAR 

errorstring  :  string; 

AF:  ArcdiiveFile; 
begin 

{  Get  the  name  of  the  archive  to  read  from  the  listmenu  and 
read  the  parameters  and  the  archive  data  into  the  exiimenu 
or  auxeditmenu  areas  (depending  upon  which  is  currently  active 
in  the  split  screen  or  on  the  main  screen)  and  fill  in  the 
apprepriate  cell  grid  data  for  the  hours  selected  in  the  loaded 
parameters  ) 

IF  listmenu-'. directorylist. picked  >  0  IHEN 

begin 

leftlcwerstatus''.archivefile  :=  listmenu^. selectedfile; 
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i^ign(AF>ARQn>VEPJmif^\'+leftlciwei?status*.ar^  ; 

Beset  (AF) ; 

ItestoreAnAivePaiaineters  (AF ,  editmenu ,  LeftSaveCanroent ) ; 

Close  (AF) ; 

CancelOontext;  {  pep  down  the  list  menu  ) 

CancelContext;  {  pep  down  the  file  menu  } 

LeftSideStatus''  .Shew; 

IfiftlowerStatus^  .Shew; 

IF  leftexpanded  THEN 

RefIhresholdCells(BigCellGrid,  editmenu#  leftlowerstatus) 

ELSE 

ReThresholdCells  (LeftCellGrid#  editmenu,  leftlcwerstatus) ; 

IF  LeftExpanded  THEN 
begin 

BigCellGrid''  .Shew; 

BigMap^  .SHCW; 
end 
ELSE 
begin 

LeftCellGrid^  .Shew; 

LeftMap^.SHCW; 

end; 

IfiftLcwerStatus'^.^rtx  ;*  editmenu; 

LeftlewerStatus''  .Show; 
end 
EISE 
begin 

messagebox.displaymessage(  (GetMaxX  DIV  2)  - 
(textwidth('File  Not  Selected')  DIV  2), 

GetMaxir  DIV  2,1, 

length('File  Not  Selected') , Hatred, white, 

'File  Not  Selected') ; 

beep; 

messagewait; 
messagebox . hidemessage ; 
end; 
end; 

(***************************************************************************) 

prccedure  ri^tlistmenuacticn; 

{ 

■*********'******************'***'******'****'**'***ilr'*»w****'*****'****'**iir'**i«**** 
*  * 

*  HJRPOSE  * 

*  Procedure  to  get  the  name  of  the  archive  file  to  be  loaded  * 

*  and  to  perform  the  actions  necessary  to  load  the  info  into  * 

*  the  right  split  cell  grid  display.  * 

*  * 
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***********★*★**************************************************>>•******* 


) 


VAR 

AF:  ArchiveFile; 
begin 

{  Get  the  name  of  the  archive  to  read  fran  the  listaenu  and 
read  the  parameters  and  the  archive  data  into  the  exitmenu 
or  auxeditmenu  areas  (depending  upon  which  is  currently  active 
in  the  ^lit  screen  or  on  the  main  screen)  and  fill  in  the 
appropriate  cell  grid  data  for  the  hours  selected  in  the  loaded 
parameters  } 

IF  rightlistmenu‘'.directorylist.picked  >  0  THEN 
begin 

rightlcwerstatus''.archivefile  :=  ri^tlistmenu^.selectedfile; 
Assign(AF,ARCHIVEPAIH+-'\''+ri0itlcwerstatus''.archivefile) ; 

Reset (AF) ; 

RestoreArchivePa3.-ameters(AF,  auxeditmenu, Rii^tSaveConment) ; 
aose(AF)  ; 

CancelContext;  {  pop  down  the  list  menu  ) 

CancelContext;  (  pep  dewn  the  file  menu  ) 

RightSideStatus''  .Shew? 

RightlowerStatus''  .Shew; 

IF  Ri^texpanded  THEN 

ReThresholdCslls(BigCellGrid,  auxeditmenu,  Ri^tlowerstatus) 
ELSE 

ReThresholdCells(Ri^tCellGrid,  auxeditmenu,  Rightlcwerstatus) ; 
IF  Ri<^tEXpanded  THEN 
begin 

BigCellGrid^  .Shew? 

Bic^J^  .SJKW? 
erd 
ELSE 
begin 

RightCellGrid'' .  Shew  ? 

Ri^tMap' .SHOW? 


end? 


RightLcwerStatus'' .  eptr  :=  auxeditmenu? 
Rightlcwerstatus'' .  Shew  ? 
end 
ELSE 
begin 

messagebox.displaymessage( (GetMaxX  DIV  2)  - 
(textoadth('File  Not  Selecoad')  DIV  2) , 
GehMaxY  DIV  2,1, 

length('File  Not  Selecced')  ,liahcrsd, white, 
'File  Not  Selected') ; 

i;een? 


messagewait? 


F-293 


pgnooedure  Rel  iabilityActijon; 

{ 

************************************************************************ 


* 

* 

* 

* 

* 

* 


H1REC6E 

Procedure  to  display  1±e-reliability  (QR)  menu  frtan  the 
left  SDlit  and  sain  edit  screens. 


* 

* 

* 

* 

* 

* 


**AA*AA*********»A****************************************************** 

} 

begin 

pii«^xx!ntext  ( ^lel  iabilitylistmenu^ ) ; 
sbOMCcntext; 
end; 


^ *********************************************************************  *******) 

procedure  AuxReliabilityflction; 

{ 

************************************************************************ 


* 

* 

* 

* 

* 

* 


H]RPCSE 

Procedure  to  display  the  reliability  (QR)  menu  frm  the 
right  split  edit  screen. 


rk 

* 

* 

* 

* 

* 


} 

begin 

pushcontaxt ( ' auxreliabilitylistmenu' ) ; 
showcontext; 
end; 

(  ****************y**********************************************************^ 


procedure  RelListMenuAction; 

{ 

***********************************  ******W****X*************1«****tllt****X'W 
*  * 

*  FURPCSE  * 

*  Procedure  to  get  the  name  of  the  QR  sat  file  to  be  leaded  * 

*  and  to  perform  the  actions  necessary  to  load  the  info  into  * 
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*  tile  left  and  sain  edit  screens:  * 

*  * 
*/i******MA/iMM****AAMMM/tiiM**itAiHk*it*t*kk***********M*******iiA********Miikii*. 


) 

begin 

IF  reliabilitylis&ttasi^.directcrylist.pidcEd  >  0  IHHI 
begin 

editoeni^.GI^File  :=  rel iabil itylistmenu^.SelectedFile; 
canoelOonteagt; 
end 
ELSE 
begin 

messaQebJx.di^layinessage(  (GeOfeodC  DIV  2)  - 
(text3ridth('File  Ndt  Selected')  DIV  2) , 

GetMaxY  rav  2,1, 

lengthC'File  Not  Selected')  ,li^ttred, white, 

'File  Not  Selected')  ; 

Ixepj 

messagewait; 

siesiaaggbox.hidemessage; 

end; 

end; 


(^************AA**AAA******A***********A**A*****************A****************^ 


procedure  AtodtelListMenuActiai; 

( 

1 


* 

* 

* 

* 

* 

* 


* 

PURPOSE  * 

Procedure  to  get  the  name  of  the  QR  set  file  to  be  loaded  * 
and  to  perform  the  actions  necessary  to  load  the  info  into  * 
the  ri^t  ^lit  edit  screens.  * 

* 


************************************************************************ 


} 

begin 

IF  auxreliabilitylistmenu''.directorylist.picked  >  0  THEN 
begin 

auxeditmenu'^ . QRFile  :=  auxreliabilitylistinenu''.SelectedFile; 
CancelCcntext; 
end 
ELSE 
begin 

iaessagebox.displayinessage((GetMaxX  DIV  2)  - 
(textwidth('File  Not  Selected')  DIV  2), 

GetMaxY  DIV  2,i, 

length('File  Not  Selected')  ,lightrsd, white, 

'File  Not  Selected') ; 
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FileN^:  HQCS.iaS 


beep; 


File  Name:  IRXS.EAS 


Dumy  pmoedare  fcr  buL-tcn  dldcs  on  tti&  various  oeLl* 
grid  di^laysi  ^eeps  tbe  rigtit  button  fron  cance},ling  * 
tbB  celldlsplay  contexts.  * 


* 

* 

* 

*  » 


(*  do  notbing  on  tbe  ric^  mouse  button  hit  for  tiie  cell  grid  *) 

begin 

end; 


^^*iL*k**ii***ii*ii******ii*************iHt********it***i***ii***it*i(iiic***************^ 

{$!  procs2.pa5} 

{$F-} 

begin 

new(QE^tabase) ; 

WeicfitsSaveOannent  := 

LeftSaveOcranent 
Ri^itSaveOcninent 
QueueSaveCcnanent  := 
end. 
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^*AA**ji******A*******.*******»*************»*******************-***^**.**** 


*  * 

*  HCGRAH  NAME  -  Onega  Berfonnancs  Assessanent  * 

*  and  * 

*  Oovezagre  Evaluatlcn  * 

*  (EfiCE)  * 

*  Wocicstation  * 

*  * 

*  UNIT  NAME  -  Bart  of  the  HOGS  Unit  * 

*  * 

************************************************jjt*******  **************** 
*  * 

*  T^-is  .program. was  pr^ared  ;by  * 

*  * 

*  The  Analytic  Science  Corporaticn  (TftSC)  * 

*  55  VfeOJoers  Brook  Drive  * 

*  Beading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  an  a  Iffl  PC/AT  or  caipatible  * 

*  under  MS-DOS  3-3  or  hic^ier  with  a  miriiniiim  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccnpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  nuntoer  * 

*  Dr0G23-89-C-20008,  Thsk  Order  90-0001,  Thsk  No.  5834,  for  * 

*  the  Omega  Navigation  Systan  Center  (CNSCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Continuation  of  the  routines  defined  in  the  PROGS  laut.  * 

*  ★ 

*  * 

*  ★ 


*******dHlr*******************************^**TlnWr**************************  J 

{********  include  the  routines  in  procs3.pas  file  ************) 

($I  procs3.pas) 


Procedure  Weightslistmenuaction; 

{ 

************************************************************************** 
*  * 

*  PURPOSE  * 

*  Invoices  the  list  menu  of  available  weii^ts  files  from  the  * 

*  weights  editor.  * 

*************************************************i***********iir»r***»t****7ir* 

) 

var 

eptr  :  ememritr; 
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File  Name:  I5?DCS2.I>ftS 


begin 

IF  Wteig^itslistmenu''.diiBCtoryiist.pic3ced  >  0  THEN 
begin 

Wei^O^lGrid^  .HasBeenChanged  :=  FMSE; 

Wei^itOellGrid^  .weic^itsflle  :=  Wei^itslistmenu^  .selectedfj]  e; 

getwel0itset(^?tx,Weigfttoellgrid,Weic^itsRtth  +  +  Wei^itslistmenu^ . selectedf ile) ; 

CanoelOcntext;  {  pep  dewn  the  list  menu  } 

CancslOontext;  {  pep  down  the  file  menu  } 

ShowOontext; 

end 

else 

begin 

iDessagebooc.displaymessage((GetMaxK  DIV  2}  - 
(textwidth('File  Not  Selected')  DI7  2), 

GetMaxy  DIV  2,1/ 

length  ('File  Not  Selected')  ,li^itred,vhite, 

'File  Not  Selected') ; 

be^; 

messagewait; 
messagebox.hidemessage ; 
end; 
end; 


(**'iHt******iWf************************5(rtk*********iWt**************************J 


procedure  Weightsloadbutton; 

{ 


*  * 

*  FUREOSE  * 

*  Displays  the  wei^t  loeui  menu  for  the  weight  editor.  * 

*  * 


*************'*******************************7lr****'*********************** 

} 


begin 

pushcontext  ( ' weightslistsnenu ' ) ; 
shcwcontext; 
end; 


(***■***■*******■***■**■******■******•*■*****■*****★***********•**************■******•**  j 

procedure  GeTdfeightSet(K7a::emeriupcr;  O^tr  ;  CellGridPtr;  fname  :  string) ; 

{ 

*****'*******'***'»c*'*'***'*»**i«:*nr*******'********  **★★**********•***■****•*  ******** 
*  * 

*  HJRPOSE  * 

*  loads  the  weight  information  fron  the  selected  wei<^t  file.* 
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FjLle.Ifeme:.  H«XS2.£2^ 


*  •  *. 
************************************************************************ 

) 

var 

WD  :  Weic^htsDataType; 

WF  :  Wejj^itSFile; 
i  :  integer; 
s  :  string; 

begjm 

{  ASSOMES  that  the>vfnainegalTeady  oontains„->the  to  ^the  weights  dir  } 

a^ign(nF;fhaaDe} ; 

reset{WF) ; 

{$!+} 

if  ioresult  o  0  then 
begin 

s  :*  fname  +  ^  NOT  POOND.  EKESS  ANY  KEX.'; 

messagebox. displayniessage ( (GetMaxX  DIV  2)  -  (textwicith(s)  DIV  2) , 

GetMaxy  DIV  2, 

1, 

length('123456789012345676890123456789012345678901234567890' 

li^tznagenta, 

black, 

s); 

messagewciit; 
messagebax.hidemessage ; 

fname  ;=  Wei^tsPath  +  '\'+  DEEADIIIWEIQnSFliE ; 

($1") 

assign  (WF ,  fname)  ; 
reset (WF) ; 

{$!+} 

if  (ioresult  =  0)  then 
begin 

read(WF,WD)  ; 

for  i  ;=  1  to  444  do  begin 

a^rt3^.CellAcray[i].wei^_or_coverage  :*  WD.weightdata[i]  AND  $7F; 
o:^itr^.CelLirray[i]  .region  ;=  ( (WD.WBightdata[i]  AND  $80)  o  0); 
end; 

Wei^tsSaveCanment  ;=  WD.Conment; 
close  (WF) ; 

^jtr'.weightsfile  :=  DEFADIITWEIGKISFIIS; 
end 
else 

Iog_Error( fname  +  '  file  not  found...'); 
end 
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File  Name:  mxsz.FRS 


else' 

Jbegin 

read(WF,WD) ; 

fcr  i  :*  1  to  444  do  begin 

0Gptr^.CellArray[i3  ♦v^c^jorjgoverage  :=  WD.Mei^itdata[i]  AND  $7F; 
(jSgtar^ .  Pel  1  Array [ i]  ♦region  :=  ( CWb.wei^itdataCi]  AND  $80)  o  0); 
end; 


Wei^itsSaveOcnment  :=  WD.Ocoment; 
close(WF) ; 
end; 


end; 


procedure  Wei^tsSaveButton; 
{ 


★  ★ 

*  lURPOSE  * 

*  Di^lays  the  save  menu  for  the  wei^t  editor.  * 

*  * 


*****iit**************************************************************  **** 

) 

begin 

Wei^itsSaveiienuWindcw^  .FileButton.  Change^StringfWei^tCellGrid^ .  eptx^  .Weightsfile)  ; 
Weig^itsSav^fenuWirdcw^.MenoBox.GetN'ewText(WeightsSaveCtEiinient) ; 
pushcontext  ( 'wei^tsavemenuwindcw^ ) ; 
showcontext; 
end; 


^  ************************************  JHt^ik***********************************  J 

Procedure  Weightsn>enuview(liTenu;lroenq:^  ; 

{ 

*****-*****************'***Tlr**:^*******'*i(r**********')lf**  <e******************** 


*  * 

*  HJRPCSE  * 

*  Displays  the  canment  associated  with  a  weight  file.  * 

*  * 


**********  **************:*r********:(^*iHt*******Tlf*********T<Nr**************:llf 

} 

VAR 

errorstring  ;  string; 
terrostring:  conmentareatype; 

WF;  Weii^rtsfile; 

begin 

IF  lmem''.dijrectorYlist. picked  >  0  THEN 
begin  {  read  the  stuff  in  ) 

Assign (WF,WEIGEtISPATH+'\'+lmenu''.selectedfile) ; 
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Bi^(WF) ; 

Viefc#*eigiitsCcninenfe(WF,  tar^^  ; 

Close(WF) ; 

messag^xac.di^laymR5iwage((GetJfeog  DIV  2)  -  (25*textwidth('  ')), 

GetMaxY  DIV  2, 

5,50,cyan,black,tenpstring) ; 

messagewait; 
messag^xac.iudemessage ; 
end 
ELSE 
begin 

inessagdxoc«displaymessage<'(GetMaxX  DIV  .2)  - 
(textaadthf'File  Not  Selected')  DW^'2),, 

GetItexY  DIV '2,1/ 

length('File  Not  Selected')  ,lightred, white, 

'File  Not  Selected')  ; 

be^; 

messagewcdt; 

messagebcat.hidemessage; 

end; 

end; 


(********★*****************★*************************★*****************★*★** j 


procedure  Wei^tssa  veaction ; 

{ 

*****************************iH****************************************** 


* 


* 


* 

* 

* 


RJRPOSE  * 

Causes  the  weight  set  to  be  saved  to  the  selected  file.  * 

* 


************************************************************************* 


) 

var 

filename 
Source, WF 
i 

dir 

name 

ext 


string; 

WeigntsFile; 

integer; 


DirStr;  (*  as  defined  in  the  DCS  unit  *) 
NameStr; 

ExtStr; 


begin 

filename  :=  Wei^tsSav^^enuWindcw''.FileB^tton.Text_String; 
fsplit (filename, dir, name, ext) ; 
filename  :=  name  +  ext; 


if  filename  =  "  then 
begin 

messagebox.displayroessage((3etMaxX  DIV  2)  - 
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{te3rtwidth( 'Please  Select  An  impropriate  Filename  -before  saving. . . DIV  2) , 
GetMaxy  DIV  2,1, 

length{ 'Please  Select  An  ^ropriate  Filename  before  saving. . . ') 

,  li^itred,  viiite, 

'Please  Select  An  impropriate  Filename  before  saving. . . ; 

beep; 

messagewait; 
messagebCK.liidemessage ; 
end 
else 
begin 

Wei^tCellGrid''-HasBeenChanged--;=  lALSE; 

Wei^itOellGrid^ . weig^tsfile  :=  filename; 

WeightsSav^fenuWindcw^.MemoBao£.AssignChangedIte5ct(Vfei^tsSaveCairirnent)  ; 
messagebooc.displaymessage(  (GetMaxX  DIV  2)  -  (textwidth{ 'Saving  to  file:  '+WEIGHISPAT 

(GetMaxY  DIV  2)  -  (textheight('l')  DIV  2), 

1, 

length  ('Saving  to  file;  '-fWEICSIISPAIHf'X'+filenaiiie) , 

ligfatred, 

vAiite, 

'Saving  to  file;  '4WEiaiISPAIIff '\'+filename)  ; 

SaveWeightsParaineters(WEIC3IISPAIlff'\'+filename,WeightsSaveCcinment) ; 
messagebcoc .  hidemessage ; 

hidecontext;  popcontext;  {  wipe  out  the  save  memo  window  } 
hidecontext;  popcontext;  {  wipe  cut  the  file  pick  list  drcp  dcwn  menu  ) 
end; 

end; 


function  isin (xl,yl,x2,y2,xp,yp; integer ) ;  boolean; 

{ 

************************************************************************** 
*  * 

*  HJRPCSE  * 

*  Dtility  function  that  diecte  to  see  if  a  point  is  within  * 

*  a  defined  rectangular  region.  * 

**************************************************************************** 

} 

VAR 

tx,ty;  integer; 
begin 

{  first  order  the  coordinates  } 

IF  (xl  >  X2)  THEN 
begin 

tx  :=  x2; 
x2  :=  xl; 
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xl  :=  tx; 
end; 

IF  (yl  >  y2)  TEffiN 
begin 

ty  ;=  y27 
y2  ;=  yl; 
yl  ;*  ty; 
end; 

{  now  see  if  the  point  is  in  the  cxxandinate  jbox^ ) 

IF  (xl  <=  >p)  AND  (:)q3  <*  x2)  AND  (yl  <='yp)  AND^'(yp  .<=  yl)  THEN 
isin  ;=  TFaUE 
ELSE 

isin  ;=  E2\ISE; 

end; 


^*******************★***■***■**********•*★******•*******★******★******•**********^ 
Function  GetGaxcpRegionValue (var  Region  :  boolean) : boolean; 

{ 


*  * 

*  HJRPOSE  * 

*  Utility  function  to  assign  a  region  flag  to  all  cells  in  * 

*  a  defined  rectangular  region.  * 


************************************************************************* 

) 

VAR 

stl  :  string; 

Oorrecddfei^itFcwnd  :  boolean; 
key,  oldkey,  button, 

XX, yy  :  integer; 

begin 

settextjustify(lefttext,tcptext) ; 

Get_CursorXy(xx,yy)  ; 

HidejCursor; 
setcolor  (whits) ; 

outtextxy(WeightCellGrid^  .X+350,  Wei^tCellGrid^ .  Y+WeightCsllGrid''  .Height+20flO, 
'Press  <ENTER>  when  finished') ; 

outtextxy  (Wei^itCellGrid''  .X+350,Wei^tCellGrid^  .y+WeightCellGrid^-.Hei^t+20, 
'Turn  region  on?  <Y/N>  ') ; 
oldkey  :*  -1; 
repeat 

Get_Key(Xey)  ; 

IF  T(Key  =  ord('y'))  OR  (Fey  =  crd('N') )  OR 
(Key  =  ord('y'))  OR  (Key  =  ord('n')))  THEN 
begin 

IF  oldkey  o  -1  THEN 
begin 

setcolor(basescreen2^ .color) ; 
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out±ext}y(Wei^tCellGrld^  .X+350 ,  WeightCeUQrid'' .  y+WeighteallGrid<'  .Height+20 , 
'Turn  region  on?  <y/N>  '+ciir(oldkey) )  ; 

end; 

setcolor(white) ; 

outtesctay  (Wei^tCellGrid^  .X+350,  Wei^itCellGrid'' .  Y+Wei^itCellGrid''  .Hei^t+20 , 
'Turn  region  on?  <Y/N>  '-KiirCtey) ) ; 
oldkey  :=  ]cey; 
end; 

button  :=  get_buttons; 

Until  (button  =  left_button__prBSsed)  OR  (button  =  ri^t_button_pressed)  OR 
(]cey  =  ENTER)  CR  (3cey  =  ESC)  ; 

IF  ( (button  =  left_button__pressed)  OR  (key  =  INTER) )  AND 
((oldKsy  =  ord('Y'))  OR  (oldkey  =  ord('y'))  OR 
(oldRey  =  ord('N'))  CR  (oldkey  =  ord('n')))  THEN 
begin 

IF  ((oldKey  =  ord('N'))  OR  (oldkey  =  ord('n')))  THEN 
Region  ;=  EAISE 
ftct: 

Region  :=  TEDE; 

GetGrcupRegionValue  :=  TKOE; 
end 
ELSE 
begin 

GetGnx^DRegionValue  ;=  FSISE; 
end; 

Show__Cursor(5a,yy)  ; 
end; 


(******************'*********************************************************^ 


Function  GetGrouF«eightValue(var  Weii^t  ;  integer) : boolean; 

{ 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Utility  function  to  assign  a  weight  value  to  all  calls  in  * 

*  a  defined  rectangular  region.  * 

************************************************************************ 

) 

VAR 

stl  :  string; 

CorrectWei^tFound  ;  boolean; 
k^ ,  oldki^ ,  button , 

XX/ yy  ;  integer; 

begin 

settextjustify(lefttext,tcptaxt) ; 

Get_CursorXY  (xx,yy) ; 

HidejOursor; 
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set03l^«^te)'; 

oiitte3Cby(Weiicftt0eaiGr3d^.X4350,Weiig^hfcCilI<aad^.Y4«edgtit^ 

*Vress  <nnnt>  vben  finished'); 

gitjyattxy CWedc^itflRl  1G^  .X4-350,Weic^illiGLlGrid* . Y-Hfeig^^  .Height-i'20, 

'Enter  veig^  ludaer  <0..9>  '); 
dLcDo^  :=  -1; 
rqpeat 

Get_R^(K^) ; 

IF  ({Key  >=  ard('O'))  and  (Kw  <=  ani('9')))  OHEN 
begin 

IF  oldki^  o  -1 1HQ( 
begin 

setobIar(basescreeri2^.c3QlQr) ; 

outtextxy  (WeightOeH^  «X4-350;Wei^itORl  ]  Gfid%  Y4Weic^.CRl  1  Grid^  .Hei^+20 , 

'Biter  wei^rt  nunfcer  <0..9>  '4cbr(oldlc^) ) ; 

gid; 

setoolar(vMte} ; 

outtejrt3^(Wei^itCtellGrid''.X+350,lfei^itCenGrid''.y4«ei^itceaiGa^  .Hei^+ao, 
'Biter  wei^it  nunfcer  <0-.9>  '+c±ir(lcey)) ; 
olcDoey  :=  loey; 
end; 

but±on  ;=  get_buttcns; 

ISitil  (tMttCHi  =  leftJxtttonjjressed)  CR  (buttcn  =  rigbtjxittonjscessed)  OR 
(key  *  ENTER)  CR  (3oEy  =  ESC) ; 

IF  ( (button  *  leftjDUttonjjressed)  CR  (3cey  *  ENTER) )  AND 
(oldRey  >=  ord('O'))  and  (oldR^  <=  ca:d('9'))  THEN 
begin 

wei^it  ;=  oldk^  -  ord('O') ; 

GetGnxEWei^itValue  z-  TRUE; 
end 
ELSE 
begin 

GetGrcic^Weic^itValue  :=  E?^ISE; 
end; 

Shcw_Cursor(xx,yy)  ; 
end; 


(  ****it**************it**irk***-k*****it**-k-kit******itit********ifk*****  *******  ****** ) 


procedure  ErocessGrotp; 

{ 

************************************************************************ 
*  * 

*  HJRPOSE  * 

*  Utility  function  to  assign  weight  or  region  values  to  cells* 

*  in  a  defined  rectangular  region.  * 

******************************************************************^***** 

} 

var 
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rile  Saaae:  ISDCSZ.SAS 

i»xjc,yy,3eey,l3Uttan  :  integer; 
zegicnvalue:  boolean; 
veic^itvalue:  integer; 

begin 

Getjairsat3Qr(xx,yy} ; 

Hidej::ursQr; 

setoolar  (BasescrBen2^ .  color) ; 

outtext3y(Weii^itCellGrid^.X-f20,Weig^C>llGrid^«Y4tfeic^itO»llGrid^  .Heic^+2CH-10 , 

'Please  select  Ist  Gamer  of  <3K00P...') ; 
setcalar(«bite} ; 

cwttexby  (Wei^itCeliGtid''  .X+20/#ieic^itCSeUGrid-  -  .Height+2(H-10 , 

'Please  select  2nd  Gamer  of  <S?ODP.--') ; 

Set_Garsor_Shape(finger) ; 

Show_Ciirsor(xx,yy) ; 

WeigfatCfellGrid^  .T.a5rtftocrd.x  :=  xx; 

Wei^itCellGrid^  .lastGnord.y  :=  yy; 

Weig^tCellGrid^ ♦FirstOoord.x  :=  xx; 

WeightCellGrLd^  .FjgstCoozd.y  :=  yy; 

SetWriteMode(X2ltCT)  ; 

SetOalor  (white) ; 

Beapeat 

GetjCarsorXY(xx,yy) ; 

GetJOqr(Xey)  ; 

IF  Tk^‘  in  jCursor^set)  “1521; 

MavejCursorCKey,  xx,  yy); 
button  ;*  getjxittans; 

IF  (xx  o  Wei^itCellGrid*^ .  lastCoord. x)  CR  (yy  o  Vfei^itCellGarid^  .lastCoord.y)  THEN 
begin 

HidejQirsor;  i:ectangle(Wei^itCellGrid'^  .FirstCoord.x, 

WeicjitCe.llGrid*^  .LastCoord.x, Wei^itCellGrid^  .lastCoord.y) ; 
rectangle  (Wei^tCp.l  IGrid*^  .FirstCoord.x,Wei<^tCellGrid^  .FirstCoord.y, 

XX, yy); 

Wei^itCellGrid^ .  lastCoord.  x  :=  xx; 

WeightCellGrid''. lastCoord.y  :*  yy; 

Show_Cursor(xx,yy) ; 
end; 

Until  (button  =  left_tuttcn_prassed)  CR  (button  =  right_buttcn_pressed)  OR 
(key  =  QHER)  OR  (key  =  ESC)  ; 


S€««riteMode(NC»MaLFOT)  ; 
setcolor(Basescreen2''  .color) ; 

outtextxy  (WeightCel  IGrid'^  .X+20,Wei(^tC3llGrid^  .Y-r«eightCellGrid^  .Keight-r20rio, 
'Please  select  2nd  Corner  of  GPCUP. .,'); 

{  new  process  the  case  ) 

IF  (button  =  left_buttcn_pressed)  OR  (key  =  enter)  IKEN 
begin 
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!zHid<^.picjdnc|Hei£^xts-^:EENr 

begin 

IF  Get)SnxpHei^itValT]e{Weic^itVad^^ 

ICR  i  :=  1  to  NOells  DO 

IF  isin(Weic^TtC>»llGtid^.firstcoQni.x,Wei^itt>llGrid^»fir5tooo(ni»y, 
Wei^iK>11Gadd*.lastooord»x^WelghtCieIlGand^ .  lastcoord.y , 
WeightORllflrai^.Cemrr^  .X  +  Weic^itCellflrid^.Osllftrrsy  .Width  EIV  2 
Weic^itCellGadd^.OellAr^  +  lfeic(htC^Grid''.CfellArr^  DF^ 

THEN 

WeightCeUGrid''-CellArray[i]  .weigtejarjxjverage  :=  WSL^itValxie; 


end 


ELSE  {  picking  regicns  } 
begin- 

IF  GetGtoi^RegionVcdiJe(RegionValue}-  ^IHENr 
KR  i  :=  1  to  NOells  DO 

IF  isin(Weic^itCellGrid''.firstccxjrd.x,Wei^itCellGrid''.firstcoord.y, 

Wei^itCellGrid^ .  lastcoord.x,  Wei^itCellGrid'^ .  lastcoord.y, 
WeightCeUGrid''.CellArray[i].X  +  Wei^itCeUGrid^-CellArray[i]  .Width  DIV  2 
WeightCeUGEid^.CteaiAtray[i].Y  +  Wei^.C>3,lGidd‘^.Cel].Rrray[i]  .Hei^t  DIV 
IHEN 


Weic^rta::ellGrid^.CellArray[i]  .region  :=  RegicnValue; 

end; 

ShowContext; 

WeigfafCellGrid^  .SelectingByGrocp  ;=  FJMSE; 

GetjCjrsorXY(xx,iy) ; 

HidejCursor; 

Set_Cursor_Shape  ( arrow) ; 

ShcwjCursor(xx,yy) ; 
end 
else 
begin 

SetWrit^fcde(X3RHJr) ; 

SetColor  (white) ; 

Get_CursorXY(xx,yy) ; 

HidejCursor; 

rectangle(WeightCellGrid''  .FirstCoord.x,Wei^CellGrid''  .Fijpstcoord.y, 
Wei^tCellGrid''.IastCoord.x,Wei^tCellGrid^. Lastcoord.y) ; 
SetWrit^4xae(NC!E«AIIur)  ; 
setcolor  (white) ; 

cuttextxy  (Wei^CellGrid^  .Xf20,WeightCellGrid^ .  Y-Hfei^itCellGrid''  .Hei^t+20+10, 
'Please  select  1st  Comer  of  GROUP...')  ? 

Shcw_Cursor(xx,yy)  ; 
end; 
end; 


(***************************************************************************j 


prccedore  Wei<^itsCellGridAction(selfptr  :  CellPtr;  cellnuinber:  integer)  ; 
{ 
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*  * 

*  H3RP0SE  * 

*  Rjooedure  to  perform  the  wei^it  iixrement  or  region  assign-* 

->  ment  to  single  cells  cn  tiie  wei^it  editor  grid.  * 

***********»***********»***<>*»***********»****************************** 

X 

) 

var 

xx,yy  :  integer; 
tap  :  string; 
begin 

Wbi^itCellGrid^  .HasBeenChanged  :=  IKE; 

IF  (Weig^iti3ellGrid''.SelectingByGto3cp)  OHEN' 
begin 

BrooessGrocp; 

end 

else 

begin 

GetjCursorxy  (xx,yy) ; 

Hide_Cursor; 

IF  (Wei^itCellGrid^ .  PickingWei^its)  IHEN 
begin 

STR(selQto:^.Weic^jorj0overage:2,  tup); 
setcolor(selfpt3r'.AboveColor) ; 
settextstyle(sniallfQnt,horizdir,4) ; 
setbextjustify(centertext,centerte3ct) ; 
cuttext5Cf(selfpt2r'.X  +  (selQrtar'. Width  DIV  2), 

selfftor^.Y  +  (selfptr^. Height  DIV  2) ,  tap) ; 
settextstyle(defaultfont,horizdir,l) ; 
if  selfptir'.Wei^it^orjCoverage  <  9  then 

selfptr^.Weiciit_or_Coverage  :=  selfptsr .Wei^t_or_Coverage  +  1; 
end 

ELSE  {  picking  regions  ) 
begin 

selfptr^. region  ;=  TFDE; 
end; 

ShcwWeightsCellData  (selfptr) ; 

Show__Cursor(xx,yy) ; 
end; 
end; 


^*******'*************************'***'************iir'**')lr*w***'*******************J 

procedure  WeightsCellGridCancel  (sel;^«n:  ;  CellPtr) ; 

{ 

********************  ************  *********»'*****»nr***********'x********* 

*  * 

*  PURPOSE  * 

*  Procedure  to  return  to  the  edit  screen  fran  the  weight  * 
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*  editcFi  * 

it********************************************'*************************** 

) 

var 

XX, yy  :  integer; 
tup  :  string; 
begin 

weic^itCenGrid''.BasBeenChaiiged  :=  TFOE; 

JF  (Wei^itCeUGri<a''.SelectingByGroip)  'IHEN 
begin 

WeigJitCtellGrid''.SelectiiigBy^^  ;=  EftlSE; 
setoolor  (Basescreen2<^ » cx>lor) ; 

outtext^y  (Weic^itCellGrid^  .X+2P,Wei^itCellGrid'" .  Y-rtfei^rtGellGrid''  .Hei^t+20+l0, 
'Please  select  1st  Comer  of  GROOP. .  - ; 

SetjCuisorjShape(arrow) ; 
end 
else 
begin 

Get_CursorXY(xx,yy)  ; 

HidejCursor; 

IF  (Weic^itCellGrld^  .PickingWei^ts)  THEN 
begin 

STR(selfptr^.Weight_orjCoverage:2,  tap); 
setoolor  (selfptr^  .AboveColor) ; 
settextstyle(snallfont,hori2dir,4) ; 
settextjiistify(centertext,centertext) ; 
ciuttexfay(selfptr^,X  +  (sel^jtr'. Width  DIV  2), 

selfptr'.y  +  (sel^rtcr .Height  DIV  2) ,  tjip) ; 

settextstyle(defaultfont,horizdir,l)  7 

if  selQrtx^  .W^ght__or__Coverage  >  0  then 
selfptr^.Weightjor_Cciverage  :=  selQto:^.Weignt_or_Coverage  ~  1; 
end 

ELSE  {  piciking  regions  ) 
begin 

selfptr^. region  ;=  FAISE; 
end; 

ShcwWeightsCellData(selfpcr)  ; 

Shcw_Cursor(xx,yy)  ; 
end; 
end; 


^*****'*'**'*****************'*'*'5ir***'*****'**********'**'****'*'***'**'***'»t'*Tit******'*'****^ 

procedure  Wei^t_or  Region_Buttcn; 

{ 

*  X 

*  RJRPCSE  * 

*  Procedure  to  toggle  between  the  selection  of  weights  or  * 
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*  regions-  in  wei^it  editor.  * 

it*iHt*******iiJt******k****k***ii*iiMkA**AAii»A***********ic******ic******±it*iHtA 


) 

VHR 

Mc,yy:  integer; 
begin 

getjcarsor3y(xx,yy) ; 
hidejairscr; 

Wei^^itCenGrid^-.piddnguei^xts  :=  NCT  Wei^itCeTI  Grid^  .pickingwei^its ; 

IF  Weic^itOl]  Grid^  .picklngt^^its  TBEN 

begin 

optlonsnenu'>.buttaneaTay[2].HotKey  :=  'R'; 
cptionsmenu^. buttonarray [2]  .Cbangei{aane( 'Region') ; 
end 
HSE 


begin 

optionsanenu''.biit±oncUTay[2].HotKey  :=  '\J'; 
cptionsaienu^.buttonarray[2]  .Chang^faine(^Wei^t^) ; 
end; 

hideccntext; 

pcpcontext; 

ShowCurrentPic3cChoice ; 
shcwjcursor(xx,yy) ; 
end; 


procedure  Wei^tAction; 

{ 

************************************************************************* 


★  * 

*  RIRK3SE  * 

*  Procedure  to  invoke  the  weight  editor.  * 

*  * 


*************************************************************************** 

} 

begin 

hidejaicsor; 

WeightCellGrid''.pickingwei^ts  ;=  TRUE; 

WeigfatCellGrid^  .HasBeenQianged  :=  FALSE; 

WeightCenGrid''.SelectingByGrcx^  FALSE; 

Wei^tCellGrid^.eptr  :*  editnenu; 

WeightCellGrid^.wei^tsfile  ;=  editiaanu''.weightsfile; 

GetWei^tSet  ( editaenu ,  Wei^tCellGrid ,  Wei^tsPathr '  \ '  +€ditmenu^ .  weightsf  ile ) ; 

setactivqpage(l) ; 

set_cursor_page(l) ; 

setvisualpage(L)  ; 

pushcontext('weight3creen') ; 

shcwcontext; 
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ai»Mcarscir{  (GetMaxX-  DIV  2) ,  (Getssaxy-  DIV  2) ) ; 
end; 


^»**»****************************************** *****************************) 


pmxsdure  AuxHei^itActian; 

{ 

************************************************************************ 


*  ★ 

^  f^JRPOSEI  ^ 

*  Procedure  to  invbke-the 'wei^it  editor.  * 

*  * 


} 

begin 

hidejcursor; 

Wei^tCellGrid^  .pickingweic^its  :=  “IHJE; 

Wei^itCellGrid''.HasBeenChanged  :=  FJ^LSE; 

WeightCellGrid^.SelectingByGrTx^j  :=  EMiSE; 

Wei^tCellGrid^ .  :=  auxeditmenu; 

Wei^itCellGrid^  .weightsfile  :=  auxeditmenu'' .weightsfile; 

GetWei^itSet (auxeditmenu, Wei^itCellGrid,tfeightsPath+'\'+auxeditmenu''  .wei^tsfile)  ; 

setactivqpage(l) ; 

setjcursorjpage(l) ; 

setvisualpage(l)  ; 

pushoontext  ( ^ weigfitscreen' ) ; 

showcontext; 

shcw_cursor(  (GetMaxX  DIV  2) ,  (GetMaxY  DIV  2) ) ; 
end; 


(***************************************************************************j 


procedure  V?eightslistinenuview; 

{ 

*****************************************************************x****** 


*  * 

*  HJRPCSE  * 

*  Procedure  to  cause  the  weight  ccarcnent  to  be  displayed.  * 

*  * 


************************************************************************ 

) 

begin 

weightsnenuview(v«::.ghtslistmenu) ; 
end; 


(**************************************************:,*********************,**^ 


procedure  WaightsGroupButton; 
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} 

var  XX, yy  :  integer; 
begin 

canoelcxsTtext; 

GetjCursoEXY(xx,yy) ; 

HidejCUESor; 

Mei^tCfeUGrid^.SelectingByGrocp  :=  NOT  Weic^itCenGrid''.SelecrtdngByGroi?j; 

IF  Wei^itCellGrid^  .SelectingByGrcxp  THEN 
begin 

SetjCursorjSh^Cfinger) ; 
setoDlor  (white) ; 

outtextxy  (Wei^tCellGrid''  .X+20,WeightCellGtid'' .  Y+Wei^tCellGrid''  .Height+2CH-10 , 
'Please  select  1st  Comer  of  GROJP. . . ; 
end 
else 
begin 

setcolor  (Basescreen2'' .  color) ; 

outtexGQ^  (WeightCellGrid^  .X+20  ,Wei^tCellGrid'' .  Y+MeightCellGrid''  .Heigit+20+10 , 
'Please  select  1st  Comer  of  CSSXJP. . . ') ; 

Set_Cursor_Shape(arrcw) ; 
end; 

ShowjCarsor(xx,yy) ; 
end; 
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*  * 

*  FRXSAM  NAME  -  Cknega  Perfooaanoe  Assessment  * 

*  and  * 

*  Coverage  Evaluaticai  * 

*  (PACE)  * 

*  Workstatian  * 

*  -  * 

*  UNTT  NAME  -  Bart  of  the  PROCS  Unit  * 

*  * 

*j  * 

*  Hiis  program  was  prepared  by  * 

*  * 

*  Ihe  Analytic  Science  Corporaticsi  (TASC)  * 

*  55  Wadkjsrs  Brook  Drive  * 

*  Beading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  lEM  PC/AT  or  ccnpatible  * 

*  under  MS-DOS  3.3  or  higher  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccnpatible  graphics  adapter  and  color  * 

*  monitor.  Biis  work  was  performed  under  contract  nuniber  * 

*  DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  CBiega  Navigation  System  Center  (CXCCEN) ,  Alexandria,  VA.  * 

*  * 

*  * 

*  PURPOSE  * 

*  Continuation  of  the  dbject  utility  routines  of  the  PRDCS  * 

*  Unit.  Contains  mostly  routines  for  ccnputing  Psa.  * 

*  * 

*  ★ 


********9k********-dHr***tfc******************:it  ****★*★★******★★*****★********  J 

{  Continuation  of  the  Rrocs.pas  procedure  file. 

Contains  the  main  routines  for  calculating  PSA  and  for 
re-thresholding  the  cell  grid. 

9/24/90  GRDesrochers 

) 

^  ***★*********★★**★***********★***■*:***■******■************■*****■***************  \ 


procedure  ReIiiresholdCells(a^7tr:  CellGridPtr;  ^jtr:emenuptr; 

lptr:lbarptr) ; 


***********'**'***Tir*******************************************'*********x** 
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* 

* 

* 

* 

* 

•k> 

} 

VAR 

Cellstuff;  ArcfaivedCelll^pe ; 
incnth,hcur ,  cellnuntoer;  integer; 

AvgVal,HinVal,MaxVal,£5a,RegP5a,Pac:  single; 

NuinberManthsHcxas,Wei^xtSum,BegWei^itSum:  integer; 
abovethreshold:  boolean; 

AF:  Archivefile; 
errorstring, 
s:  string; 
begin 

Assign  (AF,  AROnVEPAIHf '\'+lptr^ .  archivefile)  ; 

Reset  (AF)  ; 

GetWeightSet(eptr,OSPtr,WeightsPath»-'\'+^rtr^.weightsfile) ; 

WeightSum  :=  C; 

RegWeightSum  :=  0; 

Rsa  :=  0; 

RegPsa  :*  0; 

Iptr'.MinPsa  ;=  99; 

Iptr'.MaxPsa  :=  0; 

Iptr^.RegMinPsa  :=  99; 

Iptr' .RegMaxRsa  ;=  0; 
s  ;=  'Loading  ...Cell  '; 

inessagebox.displayitessage((GetM3xX  DIV  2)  -  (textwidth(s)  DIV  2),GetMaxY  DIV  2,l,le.ngt 

P®  ceUnumber  ;=  1  TO  NUMBERCEUS  DO 

begin 

nvOTbernoTthsheurs  :=  0; 

AvgVal  :=  0; 

MinVal  :=  99; 

MaxVal  :=  0; 

str ( ceUnumber,  s) ; 

messagebcoc. redisplayroessage (1,50,  'Loading. .  .Cell  '•^) ; 

LoadCel  IFronArchive  (AF,  cellnumber ,  CellStuf f ) ; 

PCR  month  :=  1  TO  12  DO 
FOR  hour  1  TO  24  DO 
begin 

IF  ^Jtr^.MonthSelectors [month] .selected  AND 
eptir.HourSelectors [hour]. selected  IHclf 
b^in 

IF  Cellstuff  [Month,  hour]  .Pat  <  MinVal  THEN 
MinVal  :=  CellStaff[month,hcur] .Pat; 

IF  Cellstuff  [Month,hour]  .Pat  >  Max'/al  THEII 
MaxVal  :=  Cellstuff  [month,  hour]  .Pat; 


H3RP0SE  * 

This  procedure  goes  through  all  of  the  cells  and  conputes  * 
the  global  and  regional  Psa  statistics  fran  the  Bat  and  * 

Pac  values-  Also  perform  the  cell  wei^iting  and  normalizat-* 
ion.  * 
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AvgVai-  :=’AvgVai  +  CellStajff [inaitKyhcxa?]  .Pat-; 
inc(nunfcearnTtfasfaour^  ; 
end; 

end; 

IF  nuntermcntlishoors  o  0  IHEtT 

AvgVal  :=  AvgVal/niMserncnthshours; 

IF  MinVal  <  Iptr^.Miitf^sa  THEN 
Iptir.MiilEsa  :=  MinVal; 

IF  MsoiVad  >  Ipti^.MaxRsa  IHEN 
]ptx'.Ma:d»sa  ;*  MaxVal; 

Psa  Psa  +  Av^al*0::^3tr^ .  ceHarray [cellmmiberQ  .\^^itjorjooverage; 
Wei^itSum.  ‘.:=-wej.^tSuinA,+  a3>tr^ .  oell  array  [cgllniarbegjuWei^Ja^^  ; 

IF  q^pty^  .Ctell Array [oellnijattoferj  .regi'm^ 
begin 

IF  MinVal  <  Iptx^.PegMinPsa  THEN 
Iptr'.PegMinPsa  :=  MinVal; 

IF  Ma:^Val  >  Iptr.EegMaxRsa  IHEN 
Iptr'.PegMaxPsa  :*  MasiVal; 

RegPsa  :*  PegPsa  +  AvgVal*a^±r^.csllarray[cellnuniber] .weight_or_coverage; 
RegWei^tSum  :=  RegWeightSum  + 

OSPtx^ .  cellarray  [cellnuniber]  .weight__orjX)verage; 

IF  MinVal  <  Iptn^' .RegMinPsa  THEN 
Iptr'.RegMinPsa  ;*  MinVal; 

IF  MaxVal  >  Iptr  .RegMaxPsa  THEN 
Ipftx' .RegMaxPsa  ;*  MaxVal; 

end; 

CASE  ^rtx^.PsaReportMode. Picked  OF 
PsaMin: 
begin 

IF  MinVal  <  Psa. Value. Value  THEN 

abovethreshold  :*  FALSE 
ELSE 

abovethreshold  ;=  TRUE; 

Pac  ;=  MinVal; 
end; 

PsaMean; 

begin 

IF  AvgVal  <  eptr'. Psa. Value. Value  THEN 
abovethreshold  :=  FALSE 

abovethreshold  ;=  THJE; 

Pac  :=  AvgVal; 
end; 

PsaMax: 

begin 

IF  MaXVal  <  S3tr'. Psa. Value^ Value  THEN 
abovethreshold  ;=  FALSE 
ELSE 

abovethreshold  :=  TRUE; 
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Pac  :=  MaxVal; 
end; 

end;  {  CaSE  } 

CS3^3tx^.ceUarray[c»lliiuinber].abcwethreshold  :=  abovethreshold; 
oa)tr^.c»Uarxay[cellnuniber].Pac  :=  Pac; 
end;  {  for  oellnumber  :=  1  to  NUMBEKIELLS  } 
nessagebcoc.hidemessage ; 

IF  weightsum  o  0  THEN 
Psd'  :*  Psa/wei^itSum; 

IF  regwei^tsum-  o  0  IHEN 

RegPsa  ;=  BegPsa/RegWei^itSum; 

IF  Iptr^  .MinPsa  =  99  THEN  {  didn't  find  a  min  } 

Iptir.MinPsa  :=  0; 

IF  Iptr'.PegMinPsa  =  99  THEN  {  didn't  find  a  min  )  , 
Iptr^.PegMinPsa  :=  0; 

Iptr'.MeanPsa  :=  Psa; 

Iptr^  .Re^feanPsa  :=  RagPsa; 
aose(AF)  ; 
end; 


(*********★******★*********★***************************************■*********) 

Function  aieck!Ooverage(covinfo:  covcell)  tbcolean; 

{ 

***************************************^t»Wf****************************** 


*  * 

*  PURPOSE  * 

*  Uiis  function  performs  the  coverage  calculation  for  a  * 

*  given  set  of  coverage  parameters  and  criteria.  * 


A*********************************************************************** 

) 

VKR 

SSNR,LSNR;  integer; 
begin 

QieckCoverage  ;=  EAISE;  {  Assume  FAISE  to  start  } 

SSNR  ;=  Get_SI®(Covinfo.SNR_.S) ; 

LSNR  :»  Get~SNR(Covinfo.SNR”L)  ; 

IF  (SSNR  >=  SNRIhreshold) 

( (covinfo.Phase  AND  $7F  <=  PhaseThreshold)  OR 
(covinfo.Phase  AND  $7F  >«=  100  -  Phaselhreshold) )  AND 
(covinfo.X_ang  >*  XAngleThreshold)  AND 
(SSNR  -  LSNR  >=  ShortLcngThreshold)  THEN 
begin  {  all  criteria  exc^  DM  checked  out  OK  } 

CheckCoverage  :=  TRUE; 

IF  (EMIhreshold)  IHEN  {  all  criteria  OK,  is  CM  check  } 
begin 

IF  (covinfo.Phase  AND  $80)  o  0  IHEN  {  all  crirera  passed,  EM  check  is  on  ) 
CheckCoverage  :=  FALSE;  {  CM  =  mode  0  IF  bit  8  =  0) 

end; 
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end? 

end; 


Procedure  03t5xitePsa(€ptx;emenuptr;  lptr:lbarptar) ; 
{ 


* 


* 


*  HIRiOSE  * 

*  Bus  procedure  performs  the  ccnputation  of  the  Psa  value  * 

*  by  looping  throu^-  all  cells/times,  checkijig,  coverage,  and  * 

*  retrieving  the  Pat  values  from  the  QR  .set.  * 


) 

■KPE 

gXDPPacACell  *  ARPAYtOi  .255]  of  byte; 

VAR 

Cell  Stuff:  ArcJiivedCelliype; 

stationooveragel02,stationcoveragel36:  stationcoverageinfoptr? 
cel  Inum, month, hour, station:  integer; 
errorstring, 
s:  string; 

AF:  Archivefile; 

DB102,I»136:  DBFile;  {  file  variables  for  the  10.2  and  13.6  KHz  databases  ) 
QOOPvalues:  GDOPForACell; 

GDOPfile:  file  of  GDOEForACeU; 
begin 

{  For  each  cell  and  ccmbination  of  parameters,  get  the  cell 
coverage  info  fran  the  database,  calculate  the  coverage,  and 
then  read  the  Pa  val^3e  fran  the  QR  matrix.  Store  the  results  in 
a  tarporaiy  work  file  (one  for  each  ^lit  screen) .  } 

{  First  open  vp  the  two  database  files  (one  each  for  10.2  and  13.6  KHz. 

Bie  files  are  read  in  the  readfrondatabase  routine  } 


Assign(I»102,nAIABASEPAIH+'\'+nAIABASE102)  ; 

Resct(DB102) ; 

Assign(IHD6,DA3aBASEPAIH+'\'+DAIABASE136)  ; 

Reset(DB136) ; 

Assign((TOPfile,PACEPABi+'\'4<3X)PDAIABASE)  ; 

Reset  (GDOPFile) ; 

Assign(AF,ARao:VEPATH+'\'+lptr*.archivefile) ; 

Rewrite (AF) ; 

s  'Processing  ...Cell 

messagebox.displaymessage(  (GetMaxX  DIV  2)  -  (textwidth(s)  DIV  2)  ,GetMaxv  DP/  2,l,le.ng 

{  save  the  parameters  that  we  are  carouting  with  ) 

SaveArohiveParamecers  (AF,  editmenu ,  leftSaveOanment) ; 
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{  cxanvert  coverage-  thresholcas-  into  1/8  dB  imits..  and,  romd-  into  int^ers  } 
ShortlcngDireshold  ;=  rcwnd(eptr^,ShortIongE?atio.valiie.val\ae)*8; 
Hiasethreshold  :=  round(^jtr^.rhaseDev.valx3e. value); 

XftngleflDhreshold  :=  round(^±r'. Jangle. Value. Valvie)  ; 

EUnireshold  :=  eptr^. DM. picked  =  OCN; 

{  aX5P  values  are  scaled  ty  10  } 

C3X)PIhreshold  raind(eptr'.SX)P. value. valiie)  *  10; 

new(stationcaveragel02) ; 
new(stationccveragel36) ; 

ReadQrOatabase  (epter^  .QRFile^QRDa^abase) ; 

FOR  cellnum  :=  1  TO'  NDMBERCELLS  DO* 

begin  {  ccnpute-  the-‘cell  Pac  for  each  cell  and  store  result  in  archive  } 
str (cellnum, s) ; 

messagebooc. redisplaymessage (1, 50 ,  'Processing. . .  Cell  '+s) ; 

{  initialize  the  cell  coverage  for  each  time  to  0  ) 

FOR  tenth  ;*  1  TO  12  DO 
FOR  hour  :»  1  TO  24  DO 

cellstuff [month, hour] .coverage  :*  0; 

{  read  8  stations  worth  of  coverage  for  the  year  for  the  cell  we  are  on  } 
CASE  eptr^.Freq. picked  OF 
FRQ102: 

ReadFrcroDatabase(DB102, cellnum, stationcoveragel02) ; 

FRQ136: 

ReadFreroDatabase  (EB136 ,  cellnum,  stationcoveragel36)  ; 

EISE 

begin 

ReadFranDatabase(DB102, cellnum, stationcoveragel02) ; 

ReadFranCatabase (DB136, cellnum,  stationcoveragel36) ; 
end; 

end;  {  CASE  ) 

{  read  in  the  GDOP  values  for  all  coverage  vectors  for  this  cell  } 

{  seek  to  -the  cellnum-l  position  because  the  file  positions  start 
at  0  whereas  the  cell  numbers  start  at  1  ) 
seek(C3X)Pfile,  cellnum-l) ; 
read((2X)Pfile,GD0Pvalues) ; 

FOR  Station  ;=  1  TO  8  DO  {  Carputa  the  coverage  for  all  hours/months  ) 
begin 

FOR  month  :=  1  TO  12  DO 
begin 

{  first  check  to  see  if  the  station  is  on  and,  if  it  is,  make  sure 
worst  case  has  not  been  selected  and,  if  it  is,  the  station  is 
not  in  anual  maintenance  for  this  month  ] 
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IF  ept2r.StatdonPaii^Cstatdcn].on.selec£ed  JOID 

(  -<«-a«Hrrap1  iahil  ityMnrV*!  .p^rfeaij  z  SSHfbSt)  AND 

(qaatabese^  .stationrel  iabil  it;ies[incntfa,station,mintenanpe3  o  0)}  TESf 
begin 

SNRDiresbold  Cztxind(cp^.SMR.value.value}  > 

xciund(eptr^.staticnpoHer[s^^  .Sld.Value.Value} }  *8; 

R»  hour  :*  1  TO  24  DO 
begin 

CASE  Qitr^.Fceg.pidQBd  OF 
nci02: 

IF  CbedcOGKnerage(statiaibcweragi^02^[statipn,iicnti^  IHEN 

ORllstuff  [Martfa^hour]  ;.cxyOT 

cellstuff[saiQi,b(^].^ooi«xa^  CR^($8b  :SBRf  (staticrH-l)) ;  • 

EHQ136: 

IF  Chedg0ntferage(staticnooweragel36^  [statdcn,incntfa,bour3 )  IHEN 
cellstxtf£[iixxit±,hcur].cxiverage  := 

pel  1  stJflff [mcnthybcur]  .coverage  CR  ($80  SHR  (station-l) } ; 

IRQAND: 

IF  CheckCoverage(staticncxiveragel02'^ [stctticn,acnt±i,hour] )  AND 
CheckOoverage(stetcicncoveragel36^  [statdon^manth^hcur] )  IHEN 
oellstarff [monthyhour]  .cxjverage  := 

ORll5;tuff[inonth,bciur3  .coverage  CR  ($80  SHR  (station-1) )  ; 

5SQCR: 

IF  Ched(Caverage(staticncgveragel02^  [stationyincnQiyhour] )  OR 
CheckOoverage(statixg)cx3veragel36^  [statacan, jcnth^hour] )  THEN 
nellsQiff [aonthrhour]  .coverage  :*= 

oellstuff [incnth,hour3 .coverage  CR  ($80  SHR  (station-1)); 

■  end;  {  CASE  ) 
end;  {  KR  hour  ;=*  1  TO  24  ) 
end;  {  IF  station  on  and  etc  } 
end;  (  PCR  month  :=  1  TO  12  ) 
end;  (  FOR  station  ;=  1  TO  8  } 

{  now  that  we  have  coverage  for  each  time,  retrieve  Pat  for  each 
fran  the  (R  file  ) 

Ft2R  mcarth  :=  1  TO  12  DO 
begin 

PCR  hour  :=  1  TO  24  DO 
begin 

{  check  (a»P,  if  above  threshold  then  the  cell  is  "not"  covered  } 

IF  GDOPvalues[oellstuff[month,hour3. coverage)  >  OXDPthreshold  THEN 
Cel  1  stuff  [month, hour)  .Pat  :=  0 
ELSE 

CASE  QJtr^.StatioriReliabilityModel. Picked  OF 
SPMbest:  Cellstuff [nonth,hour3  .Pat  := 

QE^tabase^.  best  [month,  call,  stuff  [month,  hour)  .coverage]  ; 

SPMncxn;  Cellstuff [aicnth,hciur3  .Pat  := 

QRDatabase^  .nan[month,ce'i  1  stuff  [month,  hour]  .coverage] ; 

Sraiwrst;  Cellstuff [m3nth,hour3  .Pat  := 

QREatabase^.nan[month, cellstuff  [month, hour]  .coverage] ; 
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end;  {  caSE  } 

end;  {  FOR  hour  ;*  1  TO  24  } 
end;  {  HU  aoiith  1  TO  12  } 
StaajRCfellToftrciiLve(AF^c«llnm>..ORl1Stu^ ; 
end;  {  TOR  ORlInim  1  TO  NCHBERCEUS  } 
iiiessag^xac.hidesessage; 
diepose(staticn3averagel02) ; 
di^ose(st2ddcna3veragel36) ; 

CloGe(AF} ; 

Qose(DB102)  ; 

Cl0Ge(EB136) ; 

Close((3X)EFile)  ; 

end; 


procedure  differenoebutton; 
{ 


*  HJRPCSE  * 

*  This  procedure  activates  the  difference  menu  display.  * 


} 


var 


st;  string; 
begin 

IF  currentcontext  =  'splitscreen'  THEN 
begin 

hide_cursor; 
setactivqpage(l) ; 
set_cursor_page(l) ; 
setvisualpage(l) ; 
pushcontext('diff screen') ; 
shcwcontext; 


difference2''.lailite(difference2''.Xfl,Difference2^.y+l) ; 


u  « VAX  u  91; 


1;  St  ;=  '  '+chr(127)+'ESA'; 

2:  St  :=  '%'+chr{127)+'ESA'; 

3:  St  :=  '%'+chr(127)+'(l-PSA)'; 


end;  {case} 
setcolor  (white)  ; 

settextjustify(lefttext,tCTrtax!:) ; 
outtextxy(difference2''.X  +  difference2'' .Width  +  10, 
dif ference2^ . Y  +  5,  st) ; 
shcw_cursor(getnHxx  div  2,getmaxy  div  2) ; 
end; 


pushCQntext('diffinenu') ; 
shcwccntsxt; 
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procedure  differEnoeaccxpt±utton; 


H3RPCSE  * 

Ihis  procedure  initiates  the  ccnputZEtion  of  the  difference  * 
di^lay  cell  values.  * 


St  :  string;, 
begin 

hidfioontext; 

pcpcontext; 

showoontext; 

case  diffinenu^  .diffnode.picked  of 
l:  St  ;=  ^  "+chr(127)+"PSA'; 

2:  St  ;=  '%'+c±r(127)+'ISA'; 

3:  St  :=  '%'->chr(127)V(i-PSA)"; 
end;  {case} 
setcolcjr(v)hite) ; 

settextjustify(lefttext,taptext) ; 
outtext;Q^(difference2''.X  +  difference2^.  Width  +  10, 
difference2''.Y  +  5,  st) ; 

end; 

procedure  Dif f Cel  IGrldAction  ( selQrtr  :  CellPtr;  ceOlnumber;  integer) ; 

{ 

*  * 

*  RJRPOSE  * 

*  Biis  procedure  invokes  the  display  of  difference  display  * 

*  cell  query  window.  * 

*******************************ii(**************************************** 


const 

WindcwCffset  =  10;  (*  distance  between  the  cell  and  the  window  edge  *) 


non,  hr,xx,yy  :  integer; 
begin 

Get_CursorXY(xx,yy)  ; 
selfptr'.Hilite(xx,yy)  ; 
with  DiffCellGrid^  do  begin 
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if  (Cel  1  Anay [cell nuntoer]  .X  <  (GetMaxX  -  Si^itSideStato^'. width  - 
CellArray[cellntmber] -Width  -  DiffCel  1  'PopO^  .Width  - 
WindcH0f£sef*4?indoi^hadobAfi^^  }  thai 
DiffOellPcpDjp^.X  :=  Cellftrray[oellnuinber]  .X  + 

Cell  Array  [pen  TTuntoer]  .Width  + 

WindoiiOffset 

else 

Diff Cel  1  PcpD^  .X  :=  CellArray[cenTnaher]  .X  - 

DiffCel, IPopU^  .Width  - 
WindaiX>ffset; 

if  ( (CellArray[c«llnutnber]  .Y4<:tellArray[cellnuntoer]  .Hei^rt)  <  (Getlfeoflf  - 
leftLowerStatus^ .Heic^  -  DiffCellPopO^.Hei^it  - 
Wi2xiO(X)ffset*47irxicwShaddwWidth)  )  then 
begin 

(*  put  pcp-tp  windcw  BEICW  the  selected  cell  *) 

DiffCel  IRpOp^ .  Y  :=  CellArray[cellnuntoer]  .Y  + 

CellArray[cellnuniber3  .Hei^it  + 

WindovXDffset; 

end 

else 

begin 

(*  put  pcp-tp  windcw  ABOVE  the  selected  cell  *) 

DiffCel IPcpUp^  ♦  Y  :*  CellArray [cell, number]  .Y  -  DiffCellPqpl^  .Height  - 

-  WindcvXDffset; 

end; 

if  Dif f CellPc^rUp^ ♦  Y  <  (g'.Y  +  q^.Hei»^  +  WindofcOffset)  then 
begin 

Dif f CellPopCJp^ . Y  :=  (q^.Y  +  q^.Hei^t  +  WindcwOffset) ; 
erjd; 
end; 


DiffCMIPc^^^HilitedCellPtr  :=  @Dif fCelierid". CellArray [ cellnuniber ] ; 

FushContext ( ^DiffCelUopCp" )  ; 

ShcwContext; 

end; 

prccedure  ShowOif fCel  TData  (selfptr  ;  CellPtr)  ; 

{ 

**************■****■**•*■**•*■**■*****■***★**•**********■*******•****■****■*•*■****■*■*** 
*  * 

*  H3RF0SE  * 

*  Biis  prccedure  displays  the  actual  difference  data  in  the  * 
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cell  qjery  winacwi 


var 

ool,xx,yy  :  integer; 
dencBi,val,lval,rval:  single; 

begin 

GetjCursarXy  (xx,yy)  ; 

HidejCursor; 

if  selQrtar  .IsHilited.  then 
sel^rtr^  .S€tHilite(Fal») 
elseti 
begin- 

Ival  :*  Ieftcengrid''.cellarray[self5rtar.cellnun43er],pac 
rval  :=  rightcellgrid^ . cellartay [selftrtnr . cellnumber]  .pac 
IF  abs(lval  -  rval)  <  0.00001  TEiEN 
val  :*  0 
ELSE 

CASE  difftnenu^.diffinode.picted  OF 
1;  val  ;=  Ival  -  rval; 

2: 

begin 

IF  Ived  >  rval  IHEN 
denan  :*  Ival 

FT  SR 

denan  :=  rval; 

IF  denan  o  0  THEN 

val  :*  (Ival-rval) /denan 
USE 

val  :=  1; 

end; 

3: 

begin 

IF  (1-lval)  >  (1-rval)  THEN 
denan  :=  l  -  ival 
ELSE 

denan  :=  1  -  rval; 

IF  (denan)  o  o  THEN 

val  :=  ( (1-lval) -d-rval)) /denan 
ELSE 

val  ;=  1; 

end; 

end;  {  case  ) 

c»l  ;=  basescreen2'' .  color; 

IF  val  <  diffmenu^.lothresh. value. value  THEN 
col  :=  red; 

I?  val  >  diffiDenu''.hithresh. value. value  THEN 
col  :=  green; 
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sel^jtr'. color  :=  col; 
set:fi32style(solidfill,sel^3tr^. color) ; 
bar(sel£ptr^.Xy 
selfptr^.Y^ 
selQrtx^.X  +' 
sellptr^  .Widths 
sel^ptr^.y+ 
sel^tr'.Hei^it) ; 

end; 

setcolor(sel£ptr^  .BorderOolor) ; 
setlinestyle(solldln,0,nontMidth) ; 
rectangle  (seirptr^  .x, 
selfptr^.y, 
selj^rtr^.x  + 
selfptr^  .width, 
selfptir'.y  + 
selfptr'.Hei^it) ; 
Shcw_Cursor(x>£,yy) ; 
end; 


procedure  NextAction; 
{ 


*  Uiis  procedure  retrieves  the  next  page  of  help  for  display  * 

*  in  the  help  window,  * 

************************************************************************ 


} 

VAR 

pointer  ;  HFIPtr; 

FoundNext  ;  boolean; 

begin 

pointer  ;=  HelpFilesList; 

FoundNext  ;=  FALSE; 

vmle  (pointer  o  nil)  and  NOT  (FoundNext)  do 

begin 

if  (pointer^. filename  =  Helpt4enuWindcw''.HelpFileName)  then 
if  (pointer'. next  o  nil)  then 
begin 

HelpMenuWindcw^.HelpFileNaroe  :=  pointer^. next''. filename; 

FoundNext  :=  TMJE; 
end; 

pointer  :=  pointer'. next; 

end; 

if  NOT  (FoundNext)  then 
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else 

begin- 

Hei^MeniJVindcw^ .  Clee^ 
HeI|Ms7id?irxio«^  .ShowText; 
end; 
end; 


procedure  PrevicusActian; 
{ 


* 

* 

* 

* 


H3RPCSE  * 

This  prooediire  retadeves-ddie-sprevious  -h^p  page  :for  di^lay* 
in  the  help  window.  * 


VAR 

pointer  :  HFLPtr; 
FoundNext  :  boolean; 


begin 

pointer  :*  HelpFilesList; 

FoundNext  :*  FALSE; 

vdaile  (pointer  o  nil)  and  NOT  (FoundNext)  do 
begin 

if  (pointer'. filename  «  HelpMenuWindow^.IfelpFileNaine)  then 
if  (pointer'. prev  o  nil)  then 
begin 

IfelpMenuWindcw''.HelpFileName  :«  pointer^. prev^. filename; 
FoundNext  :=  TRUE; 
end; 

pointer  :=  pointer^. next; 
end; 

if  NOT (FoundNext)  then 
beep 
else 
begin 

HelpMenuWindcw' .  QearWindow; 

HelpifenuWindow^  .ShowText; 
end; 
end; 
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*  * 

*  FEOGRAH  NAME  -  Onega  Performance  Assessment  * 

*  and  * 

*  coverage  Eveilijatian  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME;  -  lart  of  the  EACBOBJS  iMt  * 

*  * 

*  * 

*  Biis  program  vras  ixcepared  by  * 

*  * 

*  The  Analytic  Science  Carpoaration  (TASC)  * 

*  55  Waivers  Brook  Drive  * 

*  Beading,  Massachiasctts  01867  * 

*  ★ 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  ccnpatible  * 

*  imder  MS-DOS  3.3  or  hi^ier  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  caipatible  gr^Jhics  adapter  and  color  * 

*  monitor.  Hiis  work  was  performed  under  contract  number  * 

*  nPOS23-89-c-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Onega  Navigation  System  Center  (OJSCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  »! 

*  HJRPOSE  * 

*  Hiis  file  contains  object  methods  for  the  generic  save  * 

*  window.  * 

*  * 

*  * 


constructor  Sav^fenu.Init(InitX,InitY,InitWidth,InitHei(^t  :  integer; 

InitColor,  InitHiliteColor ,  InitMemoColor , 
InitMemcf^iliteColor ,  InitBorderColor , 
InitTextOolor,InitHiliteTextColor,InitFont;  word; 
Slink;ActicriProcedure;InitFileString:String) ; 

{ 


*  * 

*  HJRPCSE  * 

*  Initialization  for  the  save  menu  window.  * 

*  * 


******************************************************************************** 

] 

const 

sw  =  60;  (*  save  button  width  *) 
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sh. 

16;  (*  ,sart^<>butt:gh>4lm<^  -*) 

ew  * 

160;  (*  edit  button  wi^  *) 

15;  (*  edit  button  hei^it  *) 

begin 

TextOolor 

;=  InitTextOolor; 

Title 

:=  'Archive  File  Annotation' ; 

TextTflbel 

:*  'FIIENAME:'; 

xoffset 

;» :5; 

yoffeet- 

menu' 


ManoBcoC'k 


:*^.6  +  taa3£theight(Te}nIabel) ; 

.  Iriit  (InitX,  InitY,  InitWidth,  InitHei^it ,  InitOolor / 
IhitBordefOolor,  2 ,  WindcwShadcwWidth)  •; 

.  Irdt  (InitX+xoffset ,'InitY4y6ffset ,  InitFc^  InitMemoColcar, 
Ini13fempHiIj,teGolpr/I^  InitHiliteTextColor , 


black) ; 

SaveButton.  Init  (IiutX+lnitWidtli-sw-4*xof f set , 

IratY^yof fset-+MenioBox.Hei^t+5 , 
sw,sh, white, black, black, vAiite,  'Save' , Slink,  'S') ; 
FileButton.  Init  (IrdtX+xpf f set+textwidth(Textr.abel)  +12 , 
InitY+Yoffset4MeinoBc3X.Height+5 , 

ew,  ^,vAute,black,black,  white,  InitFileString,  0,4,19,  FALSE) 


end; 


procedure  Sav^fenu.Show; 
{ 


*  * 

*  HJRPOSE  * 

*  Method  to  display  the  save  menu  window.  * 

*  * 


************************************************************************ 

) 

var 

XX, vy:  integer; 
begin 

GetjCursorXY(xx,yy) ; 

Hide_Cursor; 

Windcw.Shcw; 

MemoBox.Show; 
sercolor(TextColor) ; 
settextjustify(C8ntertext,centertext) ; 
cutt:extxy(X+ (Width  DIV  2)  ,Y+(yoffset  DTJ  2 ) -5-2, Title)  ; 

settextjustify(righttext,csntertsxt)  ; 

outtextxy(FileButton.X“5, FileButton. y-f(FileButton.Kei9ht  DIV  2)4-i,TextLabel)  ; 
SaveButton.Shcw; 
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FileButtoni-Shcw; 
ShowjCursor(xx,yy) ; 
end; 


procedure  Savdfenu.Hilite(3$x3S,Ypos:  word)  ; 

{ 


*  * 

*  HJRPOSE  * 

*  Method  to  hi^ic^it  the>:save.'inenu  windcw.  * 

*  * 


************************************************************************ 


begin 

ManoBax.Hilite(3{^)os,Ypos) ; 
SaveButton.Hilite(3$os,Ypos) ; 
FileButton.Hilite(Xpos,Ypos) ; 
end; 


function  SaveMenu,Action(J$x>5,  Ypos;  word)  ;boolean; 
{ 


*  * 

*  PURPOSE  * 

*  Action  method  for  the  save  menu  that  handles  the  memobox,  * 

*  save,  and  file  name  buttons.  * 


) 


var 

duinm/  ;  boolean; 


begin 

durany  :*  MemoBox. Action (}$!os, Ypos) ; 
dummy  :=  SaveEutton. Action (XiXS,Ypcs) ; 
dummy  FileButton.Action(34x:s,Ypcs)  ; 
end; 


function  Sav^ienu.KeyAction(}$X3s,Y5xDs;word;  3cey:  integer) ; boolean; 

{ 

**★*************★**★*★*★*******★★*******■******■********★********'***★***** 
*  * 

*  PURPOSE  * 

*  Keyaction  method  for  the  save  menu  that  handles  the  memcfaox* 

*  save,  and  file  name  buttons.  * 

*******************'*******5Ht*********-***'*****'******'**'S»*********-5C****W*** 

) 

var 
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duia^t  :  bcx3lean; 
begin 

K^Action  :*  false; 

if  (Saveaittcn.KeyAction(}$x»,!i!^^  then 
KeyAction  ;=  true; 

end; 


procedure  Savdfcm. Cancel; 
{ 


*  * 

*  HJRPOSE-  * 

*  Method  to  remc^/e  the  save-;meru  fran- the.. screens  * 

*★*******■*****★*★********■*★**★**★1*  ★★★**★***  ***********ilr***************** 


begin 

menu. Cancel; 
end; 
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I  ************************************************************************ 


*  * 

*  ERDC31AM  NAME  -  Onega  Perf onnance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Wortetation  * 

*  * 

*  UNIT  NAME'  -  Part  of  the«PACBOBJS  Unit .  * 

*  * 

*  ★ 

*  This,  program  waS'.prepared  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  WaDcers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  ccnpatible  * 

*  under  MS-DOS  3.3  or  higher  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  conpatible  gr^ahics  adapter  and  color  * 

*  monitor.  This  work  was  p^onnad  under  contract  number  * 

*  DrCG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (CNSCEN) ,  Alexandria,  VA.  * 

*  * 

*  * 

*  PURPOSE  * 

*  This  file  contains  the  methods  associated  with  the  lower  * 

*  and  side  status  bar  objects.  * 

*  * 

*  * 


Function  ccntolccase(st:  string) :  string; 

{ 

it  * 

*  H3RP0SE  * 

*  Utility  routine  to  convert  a  string  to  all  lower  case.  * 

*  * 
****************************************************************************** 

} 

VAR 

i:  iyte; 
tenp:  string; 
begin 

taro  :=  st; 

FOR  i  :=  1  to  length(st)  DO 
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IF  ’(ord(tenp(i])  >=  orti('A'))  THEN  {  if  it's  a  character,  convert  it  } 
tenp[i]  :»  (*r(ord(tenp[i])+32) ; 
contolocase  tenp; 
end; 

function  contostr(v;real;a,b:iJTteger) :  string; 

{ 


*  ^  * 

*'  HJRPCSE'  * 

*  Utili^  routine  to  oraTvert  -a  real  value  to  a  string.  * 

* .  * 


} 

VMl 

St:  String; 
begin 

str(v:a:b,st) ; 
contostr  :»  st; 
end; 

constructor  Icwerstatusbar . Init<InitX,  InitY, InitWidth, InitHeight , InitColor ,  InitBorterColor: w 
Init^tr;emenuptr) ; 

{ 

■*****★***»»»*  ********************************  jHt*****»>il********Tlt**1lt**»Ht*** 


★  * 

*  PURPOSE  * 

*  Initialization  method  for  the  Icwer  status  bar.  * 

*  * 


) 

begin 

borderedarea.  init (Initx,  InitY,  InitWidth,  InitHeight,  InitColor,  InitBorterColor,  1) ; 

;=  init^Jtr; 

MinPsa  ;=  0; 

MeanPsa  ;=  0; 

MaxPsa  :=  0; 

Reg^inPsa  :=  0; 

RegMeanPsa  ;=  0; 

RegMaxPsa  :»  0; 

Andiivefile  ;=  "; 

Wei^itsfile  :=  "; 

QRfile  := 
end; 

procedure  Icwerstatusbar . show; 

{ 

*******************'********************'*****X'************'********7C'»t*'JC 
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*  HIRPCSE-  •  * 


*  Di^lay  method  for  the  lower  status  bar.  * 

*  * 


) 

CONST 
xi  *  4; 
yi  =  3{2}; 
xi2  =■'■-1; 

VAR 

i/»c,yy:  integer; 
xp,yp:  integer; 
tnpstr^st:  shortstring; 
ts;  textsettingstype ; 
drdirstr; 
n:namestr; 
e:extstr; 

begin 

get_cursorXir(xx,yy) ; 
hide_cursor; 
bozderedarea.  show; 
settextstyle(smallfont,hori2dir,4) ; 
settextjustify(lefttext,topte}ct) ; 

{  row  1  ) 
xp  :«  X  +  xi; 

YP  :=  y  +  yi; 

CASE  ortr^.PsaR^xartMode.picJced  OF 
PsaMEN  ;  St  '  MIN'; 

PsaMEAN  :  st  :=  'MEAN'; 

PsaMAX  ;  St  ;=  '  MAX'; 
end;  {  case  } 
octtext}Q^(:;^,yp,st) ; 
xp  ;=  xpfxi+textwidth ( '  12345 ' ) ; 

FOR  i  ;=  1  ID  8  DO 
begin 

IF  QJtr'.staticiripcwer[i]  .CN. selected  THEN 
begin 

c«ttext}Q^(:^,yp,stationnames(i]  +  '  ') ; 

St  :=  contostr(eptr^.staticnpcwer[i].sld.value.-\^ue, 
epcr' .  statioroower  C  i  ] .  sld.  value,  int , 

.  stationccwerC  i] .  sld. value,  frac)  ; 
aittextxy(:q>ftextwidth('  OFF')-textwidth(st)  ,yp,st) 
end 
else 

cuttext:Q^(jC3,yp,ststionnaDes(i]  -r  '  OFF'); 
xp  ;=  xp  +  taxtwidth('A  OFF')  +  xi; 
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€nd^ 


{  zov  2  } 

TCP  :*  X+xi; 

yp  :=  y+2*yi+texaieight{*l'); 
outtectxy(3q),sp/  P  '),* 
o»itte9etX5f{3qp,ypf2, '  SA') ; 

35)  :*-35>f3d4^toct3ddth( '12345'); 
o«Jtte)ct3(y{3^/yp>  'SNR'.) ; 

35>  := -35>f3d+te)ct5ddai{<SNR') ; 

0“tt®ct3y  {3jpVyp,  'S/L') ; 

35)  ;»  35>«d+te3CtMidt±i'{^?S/L') ; 
outte3Ct3y{35),yp,  'ANG') ; 

35)  :=  35>f3d+te3Ctwidth('MIG') ; 
autt:ej£t3Q^(35),yp, '  EM'); 

35)  i-  35>t-3cL+tejctaddth('  EM') ; 
cut±ext:^(35),yp,  'EEV') ; 

353  :=  35>f)d+t£3Ct3ddth('EEy') ; 

cutte3ct3{y{35),yp,  'n«Q') ; 

35)  :=  :5>f)ci+te3rt5axith('I3?Q') ; 
outtext3<y(35),yp,  ^SPM  ') ; 

35:  ;»  3534-3d4^te3ctwidth{'SIW') ; 

{  ac^usted  width  of  KA  display  to  allow  for 
addition  of  {3»P  criteria  9/13/90  CRD  } 
c»itt®rt3‘y{5¥'/yp/®P  *)7 
55>  :=  35)f3d+te)ctwidth('GDP') ; 

OUtte3Ct3qr()5),yp, 'p  '); 
aitte5ct){y(35),yp4-2, '  SA'); 

35)  ;=  35)fxi+te3Ctwidth('I5A'); 
c*'rt:text3Qr(xp,yp,  'MDT') ; 

35)  ;=  35)f3d+te3rtwidth('MIN')  ; 
c«tt®*Qr(35>,yp, '  MEAN'); 

35)  :=  35>f3d.+textwidth('  MEAN')  ; 
cutte3ct:Qr(35),yp,  'MAX')  ; 

{  row  3  } 

3CP  :=  X+3d; 

yp  :«  y+3*yi+2*tectheight('l'); 

cxitte)rt3{y(35),y+3<yi+2*te)ctheicjit('l')  ,contostr(a3tr. PSA. value. value, 
ejtr*' .PSA.value.int,  eptr' .PSA.value.frac) ) ; 

35)  :=  35>f3d.+te3£twidth( '12345') ; 

outtesdsQT  (35>fte3ctMidth  ( 'SNR' )  -textwidth  (cx3ntostr  (eptr'  .SNR.  value,  value ,  eptr .  SNR.  value 

,yp,contcstr(eptr''. SNR.  value.value,Q3t3r. SNR.  value.  int,^jcr'. SNR.  value,  frac) ) 

yp  :=3q3+3d.+te)ctwidth('SNR'); 
cuttexC3<y(3q>fte3Ct:wicith('S/L')- 

ta3ctsddth(<X!ntostr(^jtr''  .ShortlijngRatio.value.value, 

eptr^ .  ShortLongRatio.  value,  int,  eptcr  .ShorcLongRatio.  value,  frac) ) 

>YP, 


in 
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oantost2r(eptr'  .Sxartloigpatio.valiie.value/ejti:*  .SbortlcngSatio.valve..  iirt,  eptr" . 

xp  :»  3<p»xi4textKidtai(  ^S/L' ) ; 

out±ejcl3^(:qpMMxtKidai{ 'ANG' ) -textwidt3i(csntx)str  (^^3^  .SVngie.  value- valxie, 
eptir.3{An^e.value.int,Q}Cr'.Xftngle.value.frac} )  ,yp, 

oontostr  (eptr^  .Xftngle.  value,  value,  eptr*  .XAn^e.  value,  int,  eptr'  .X&ngle.  value-  fra 
CASE  eptr^.m-pidoed  OF 
UDEF  :  St  :*=  'OFF'; 

IKK  :  St  :=  '  ON'; 
end;  {  case>^) 

3ip  :*  :qpfxi+texfeHi^('ANGf) ; 

auttextxy(xpfte>ctwidth('  IM')-textwidth(st),Yp,st) ; 
xp  :*  35H-xi+textwiciai('  Ill<) ; 
outtexby  (xp*-textwicith(  'EEV')  - 

te)ctJddto(cx»itostr  -JhaseDev.  value,  value,  qjtr' .HiaseDev.  value-;  int ,  KJtr' .  EhaseDev. 

yp>oontostr{€ptr*.HiaseDev.  value.  value,eptr^.IhaseDev.value.iiit,qatr^.HiaseDeViValue.f 
CASE  aptr'.Ereq.pidced  OF 
580102  :  St  ;=  '102'; 

58Q136  :  st  :=  '136'; 

5EQAND  :  st  :=  'AND'; 

FBQCR  :  st  ;=  '  CR'; 

®!d;  {  case  ) 

xp  ;®  ;5>fxi+textwidth('DEV') ; 
outtexo^(xp,yp,st)  ; 

CASE  eptir.StaticgiReliabilityModel. picked  OF 
SIWBEST  :  st  ;*  'BST'; 

SRMNCM  ;  st  :=  'NCM'; 

sra®®ST  ;  st  ;*  'WST'; 

end;  {  case  ) 

xp  :«  xp+-xi+textsn.dth{'DEV') ; 
outtexcxy(:^,iP,st) ; 
xp  3q>+-xi+textwidth('58Q') ; 

{  an^usted  width  of  PSA  display  to  allcw  for 
addition  of  <3X)P  criteria  9/13/90  ®D  } 
outtextoQ^(35)+-textwidth(  'GDP')  -textwidth(contostr  .C3X}P.  value,  value, 

^jtr'.GD0P.value.int,Qrtx^.(3X>P.value.frac) ) , 
yp,oontostr(eptr^.GDOP.  value-value, 
eptr'. GDOP. value. int, (SOP. value. frac) ) ; 
xp  :»  xp+xi+texCwidt±i('(SP')  ; 
cuctextxy(xp,yp,  'GLB')  ; 
xp  ;»  xpfxi+textwidth('GIB')  ; 
tncstr  :*  contostr(MiiiPsa*1000,3,0) ; 

IF  MinPsa  >  0.999  THEN 
tapsti'  :=  '1.0'; 

IF  MinPsa  =  0  CKEN 
tnpstr  :=  '0.0'; 
outtext:qr(ro,yp,trpstr) ; 

:=  XErt-xi+textwidth('123') ; 
tmpstr  contostr(MeanPsa*100000,5,0)  ; 

IF  MeanPsa  >  0.99999  BiEN 
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tmasti*  :«  ‘  1.0'; 

IF  HeanPsa  =  0  IHQI 

:=  *  0.0'; 

auttexb^(3qj,yp,tBpstr) ; 

jjp  :*  xpfxi+textsid.dth( '12345') ; 

tn^str  ;s  ccntostr(KaxP5a*1000,3,0) ; 

IF  MaxEtea  >  0.999  IHEN 
tnpstr  :=  '1.0'; 

IF  MaxEsa  =  0  THEN 
tii|3str  :=  '0.0'; 
outtejd3y(^,yp,t3ipstr) ; 

{  rw  4  } 
xp  :=  X  +  xi; 

yp  :»  Y+4*yi+3*texthei^it('l') ; 

fsplit(Q3tr'.qrfile,d,n,e) ; 
e  :=  oontolocase(cc3py(e,2,leiigth(e))) ; 
ciutte3rt3Qr(:q5,yp,nfe) ; 

3$)  :=  35>fxi2+text3ddtii('nxxxXXXD.inim') ; 
f^lit (^rtar*  .wei^itsfile, d, n,  e) ; 
e  :»  cxri£olocase(copy(e,2,length(e))) ; 
outtext3Q^(3q),yp,n+e) ; 

xp  :*  3q>^xi2+taxtwidth('IX)DCOXXD.I^lm') ; 
fsplit(arciiivefile,d,n,e) ; 
e  :=  contolc)case(cqpy(e,2,length(e))) ; 
cuttextjy(xp,yp,rH^) ; 

{  adjusted  width  of  PSA  display  to  allow  for 
addition  of  GDOP  criteria  9/13/90  GRD  ) 

3?)  :=  X+10*3d+te3rtwidth('12345SNRS/IAngCM  DEVSFMFrgSDP' )  ; 

cutte3Cb{y(xp,yp,  'PEG') ; 

xp  :=  3?rt-3d.+te3£twidth('PBG') ; 

tacstr  :=  concostr(PegtlmEsa*1000,3,0) ; 

IF  Re^linPsa  >  0.999  HJEN 
tapstr  :=  '1.0'; 

IF  PegMinPsa  *  0  TEIEN 
tirpstr  :=  '0.0'; 

(xrttesdoy  (3q3 ,  yp  ^  biipstrj  ; 

3®  :=  3q>f3d+te3ctwidth('123') ; 

tnpstr  :=  ccntostr(PegMeanPsa*100000,5,0)  ; 

IF  Pe^feanPsa  >  0.99999  THEN 
trpstr  :=  '  1.0'; 

IF  Pei^feanEsa  =  0  THEN 
tapstr  ;=  '  0.0'; 
outte3ct3jy(3q3,yp,fc:irstr)  ; 

3q3  ;=  3^3dL+te3ftwidth ( '12345' ) ; 
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tnpstx  :=  ccntostr(BBC|MaxRsa*1000,3,0) ; 

IF  BegMaxRsa  >  0.999  IHEN 
duxitix  :=  '1.0'; 

IF  BegMaxRsa  =  0  TE3EN 
GifXntr  ;=  '0.0'; 
outtextoy(xp,yp,tnp6tr) ; 
line  (X+1,  Y+3*yi+3*textheight  ( '  l ' )  +2 , 

X+l+9*xi+textwi<ith  ( '  12345SNRS/LftngCM  DEVSBMFrqSDP' ) ,  Y+3*yi+3*texthe 
line  (X+l+9*xi+textwidth( '  12345SNRS/IAngCM  DEVSBMFrgaaP' ) ,  Y+2*yi+textheight  ( '  1 ' ) , 
X+14^*xi+text3ddt±('12345SNRS/Lftn^  DEVSWlFrqtaDP')  ,Y-+Height-1)  ; 

xp  :=  X+l+xi+t:extwidth('MERN  '); 
yp  :=  Y+2*yi+texthei^t('l')-l; 
line{xp,yp,X4wicith-l,yp) ; 

FCR  i  :=  1  to  8  DO 
begin 

line(xp,Y+l,;q),yp)  ; 

35)  :=  xp  +  xi  +  textwidth('A  OFF') ; 
end; 


shciw[_cxirsor(xx,yy)  ; 

settextstyle(defaultfont,hori2dir,l) »' 

end; 

constructor  sidestatusbar . Init (InitX,  InitY, Initwidth, InitHeight ,  InitColor, InitBorderColor: wo 
Initcptr;emem:ptr) ; 

{ 

************************************************************************ 


*  * 

*  HjBPCSE  * 

*  Initialization  method  for  the  side  status  bar.  * 

*  * 


************************************************************************** 

} 

begin 

borderedarea .  init  ( InitX ,  InitY ,  Initwidth ,  InitHeight ,  InitColor ,  InitBorderColor ,  1 ) ; 
epcr  :=  initeptr; 
end; 

procedure  sidestatusbar. shew; 

{ 


*  * 

*  FUEPOSE  * 

*  Display  roethed  for  the  side  status  bar.  * 

*  * 
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»c;yy>i:  integ^; 
ta/twiyi,xi:  word; 
begin 

getj=utsor3Qf(xx,yy) ; 

Kidejcattsor; 
bocderedarea.show; 
set:textatyIe(smllfont^hori2dir^4) ; 
settext^usti^(leftt:ext,tcpt:ext) ; 

th  :=  texthei^('l')+2; 
tw*:*  textwiditii(/l')+l; 
yi  :«  2; 
xi  :*  4; 

setoolcar  (bcndteroplor) 

KR  i  :*  1  TO  12  DO  - 

eutt:ext:Q^(X+xi,Y+yi+(i-i)*2*th,MA[i])  ; 


setfillstyle(solidfill,bordertx)lor) ; 

KR  i  :=  1  TO  12  DO 

IF  eptr^.Morit±SelectorsCi] .selected  UJEN 

SttR(X+xi-2, Y+l+yi+(i-l) *2*th,Xrxi+tw,Y+yi+(i-l) *2*tbfth) ; 


setcolor(color) ; 

FOR  i  ;*  1  TO  12  DO 

IF  eptr^.MonthSelectorsCi]. selected  THEN 
cxitte3ctxy(X+xi,Y+yi+(i-l)*2*th,MA[i]) ; 


setc»lca:(bordercolor) ; 

line (X+xi+t5«-3 ,  Y+2 , X+xi+t(^3 ,  Y+height-2) ; 

{  new  write  the  heur  choices  ) 
tw  :*  textwidth('ll')+l; 
xi  :*  2*xi+textwidth('l')  +  4; 
setcolor(bordercolor) ; 

KJR  i  :=  1  TO  24  DO 

outtextxy(X+xi,Y+yi+(i-l)’*th,HburNaiives[i]) ; 

setfillstyle(solidfill,bordercolor) ; 

FOR  i  ;»  1  TO  24  DO 

IF  eptr^.Haj(rSelectors[i] .selected  THEN 

b^(X+xi-2, Y+l+yi+(i-l)  *th,X+xi+tw,Y+yi+(i-i)  *thrth) ; 

setcolor (color) ; 

FCR  i  :=  1  TO  24  DO 

IF  artnr'.hourselectorsCi] .selected  THEN 

c«ttext:Q^(X+xi,Y+yi+(i-l)*th,HourNainesfij) ; 

shcw_cursor(xx,yy) ; 
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set±extstyle(dBfeultfcnt^jMrizdir,l)  ; 

end; 
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*  .  * 

*  PROGRAM  NAME  >  Omega  Perf ormance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  .  * 

*  Wortetation  * 

*  * 

*  UNIT  NAME.  -  TASCtOGO  Unit  * 

*  * 

*  * 

*  Hiis.'-prpgrain^was  * 

*  * 

*  Hie  Analytic  Science  Corporation  (TASC)  * 

*  55  walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  canpatible  * 

*  under  MS-DOS  3.3  or  higher  with  a  Tninimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  cccpatible  gr^Siics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DiaG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Ctoega  Navigation  System  Center  (CNSCEN) ,  Alexandria,  VA.  * 

*  * 

**************************************1k*****  ***************************** 
*  * 

*  PURPOSE  * 

*  This  unit  handles  the  generation  and  di^lay  of  the  * 

*  PAGE  initialization  screen  and  also  of  the  TASC  logo  * 

*  that  is  on  the  initialization  screen.  * 

*  •  * 

************************************************************************ j 

UNIT  tasclogo; 

Interface 

Uses  azr,Grcph,CursrObj,ErrIog; 

CONST 

logofile  =  '  TASCTOGO.  VEC'  ; 

PROCEEORE  DisplayilASCIogo(Spos,Ypcs:integer;scaIe:2real) ; 

PROCEDURE  Displaylcgo; 


Iirolementation 
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TXEE- 

logolistptx  =  ^logolist; 

Icjgolist  =  HEOSRD 

fwptx,blqptr:  logolistptx; 
X,  Y:  Integer; 

Flag:  Byte; 
cocrntt  :  integer; 

END; 


vaR 

logo_List:  logolislprtr; 
procedure  Di^laylogp; 

{ 

it  * 

*  PURPOSE  * 

*  Utility  routi2>e  to  display  the  PACE  specific  initialization* 

*  screen.  * 

************************************************************************ 

} 

var 

key,ixitton, 
yof f set , xof f set , 
x,Y  5  integer; 

di  ;char; 
begin 

setfillstyle(solidfill,vAiite) ;' 
settextstyle(Triplexfont,  Hori2Dir,5) ; 
settextjustify(lefttext,tcpte)ct) ; 
bar(0,0,getmaxx,getinaxy) ; 

SetIineStyle{solidln,0,'IluckWidth)  ; 
setcolor(blue) ; 

X  :=  (GEIMAXX  DIV  2)  -  (textwidth( 'P  A  C  E')  DIV  2)  ; 

Y  :=  50; 

yof fset  :*  textheid^t ( '  1 ' ) ; 

rectangle(X-8,y+4,X+textwidth('P  A  C  E')+4,Y+texthei^t('C')+8) ; 
Outtexb£y(X,Y,  'P  A  C  E') ; 
settextstyle(Triplexfont,  Hori2Dir,3) ; 

X  :=  X  -  65; 

setcolor(red) ; 

Outtextxy  (X,  y+yof fset+textheight  ( '  1 ' )  *1  ,  'P' ) ; 
setcolor(blue) ; 

Outtextxy (X+textwidth( 'P' )  ,Y+yoffset-frexcheighr('l')*l  , 'erforroance') ; 
setcolor(red) ; 
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0ufecext3«y(X+text3ridth('^Performai«  0  ,^+yoffset+textheight<'l')*l  ,'A'O'; 
setoolor(blue) ; 

(Xit±ext3Qr(x+text3a(itli('Perfoi3^^  A')  ,Y+yoffset+texthei^{'l")*l  , Assessment') ; 

Outtext)y(GetMaxX  DIV  2  -  TEXIWiniH('&')  DIV  2,  Y+yoffset+textheight('l') *2, ; 

X  ;*=  X  +  30; 
setoolor(red) ; 

Outtexb^(X*Y+yoffset+textheight( '1') *3  ,  'C')  ; 
seta5lor(bltie) ; 

CXittext3Qr(X+textwidth('C')  ,Y+yoffset+text±fiight('l')  *3  ,  'overage'^  ; 
setoolor(rBd) ; 

0uttext»y(X+textwidth('Cc3verage=»  ')  ,Y+yoffset+textheight('l'-) *3^ ,  'E')  ; 
setoplor  (blue)*;  ' 

C>ittextxy(X-hftextwictth('Cavera  E') ,Y+yoff^+textheight('l')*3  /valuation'); 

Y  ;*  Y+yoffset+texthei^('l')*5  +  15; 
settextstyle(Triplexfont,  HorizDir,!); 

outtextoQ^(GetMaxX  DIV  2  -  textwidth( 'developed  for')  DIV  2,Y/develcped  for')  ; 
outtextxy(GetMaxX  DIV  2  -  textwidth( 'United  States  Coast  Guard')  DIV  2,Y+texthei^t('l')* 
outtextxy(GetMaxX  DIV  2  -  textwidth('CMBGA  Navigation  System  Center')  DIV  2, 
Y+textheight('l')*3,  'CMEIGA  Navigation  System  Center') ; 


rectar^le(0+4,0+-4,getinaxx-4,getmaxy-4) ; 
DisplayTascIogo  (getmaxx-150 ,  getmaxy-40 ,0.13); 
settextstyle{defaultfont,horizdir,l) ; 

r^»at 

button  :=  getjxittons; 

Getjcey(key) ; 

until  Ttey  o  0)  01^  (button  »  left_button _pressed)  or 
(button  »  ri^t Jxrt:ton_pressed)  ; 


end; 

EROCEDCIRE  Read_logolist; 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  Procedure  to  get  the  list  of  vertices  for  the  TASC  lego.  * 

*  * 
************************************************************************ 

) 
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vm 

Tatp:  logolistptr; 
last:  logolistptr; 
flist:  Text; 
cxxmter  :  integer; 


Read  a  list  file  and  attach  to  the.listptr  } 


BEGIN 

{SI-} 

Assign (flist,  logofile) ; 

Reset  (flist) ; 

($1+) 

IF  IQResult  o  0  THEN 

IogJError('logo  file  not- available') 

ELSE  BEGIN 

logoJList  i*  NIL; 
last  :=  logo_list; 
counter  :=  0; 

WHILE  NOT  BOF(flist)  DO  BEGIN 
inc  (counter) ; 

New(Tenp) ; 

IF  (Tenp  *  nil)  THEN  BEGIN 

l£!g_Error(' Insufficient  memory  for  readii^  in  TASC  lego') ; 
Exit; 

END; 

Readln (flist,  Tenp^.flag,  Teiip''.X,Teirp'.y) ; 

Tenp^. count  :*  counter; 

Tertiy'.fwptr  :*  nil; 

IF  last  =  nil  THEN  {  Our  first  node  ?} 

logo__Liist  :=  Tertp 

ELSE  {  nope.  Link  it  in  } 

last^'.fwptr  :*  Tenp; 
tenp^.b)<ptr  :=  Last; 

Last  :*  Tenp; 

END; 

Clcse(flist) ; 

END; 

END;  {Read_List} 


PROCEDURE  Deallocate  logo_List; 

( 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Utility  routine  to  release  the  memory  allocated  to  the  * 

*  TASC  logo.  * 


********Tlt*******************  ***************  *********************X******** 

) 

VAR 


File  Name;  TASOOSO.PAS 


Last;  logplistptr; 

BEGIN 

Last  ;*  logo_List; 

WHILE  Last''.fwptr'.fwptr  o  NIL  DO  {get  to  the  next  to  last  list  item) 
Last  ;=  Last''.fwptr; 

While  Last  o  logo_list  DO 
BEGIN 

di^x5se(last''.fwptr) ; 
last  :='last^.bkptr7 
END; 

dispose  (last'^^ .  fwptr) ; 
dispose  (last) ; 

END; 


EROCEDURE  DisplayTRSCIjogo(24x;s,Ypos;irTteger;scale;real) ; 

{ 

•kiiiiiiiiiiiticItiiitiiliit-k'kiiitii-kititifkii'iiititifkiiititiiiilHfkititififiiititit'itifk'itifitititititifk'ififkitititifkitifkititit 


*  * 

HJRPOSE  * 

*  Procedure  to  draw  the  logo  on  the  screen.  * 

*  * 


it******it********ii*iiiiitiHt**it*irk*iiii*it*****it**ititirkit***it*ifk*******it**ii*ifii**** 

} 

VAR 

X,  Y;  Integer; 

X_Center,  Y_Center:  Integer; 
list^jtr;  Icgolistptr; 
n;  integer; 

pts;  ARRAY [0..  1000]  of  pointtype; 

xasp,yasp:word; 

col:word; 

BEGIN 

read__logolist; 

SetViewPort(0,0,GetMaxX,G€tMaxY,ClipOn) ; 
list^tr  ;=  lcgo_list; 

setcolor(blue) ;  {  the  OFFICLAL  TASC  color  } 

SetIiineStyle(Solidln,0,normwidth) ; 
setfillstyle(solidfill,blue) ; 

REPEAT 

getaspeccratio(xasp,yasp) ; 

n  :=  0; 

repeat 

pts[n].x  ;=  }$x3S+Round(listpcr'.X*scale) ;; 
pts[n].y  ;=  Ypos+round(listpcr'.y*xasp/yasp*scale) ; 
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inc(n)  7 

listptr  :*=  liatptx'^.fwptr; 

DNTIL  (list^ttr  =  nil)  'CR  (listptr^. flag  o  2) 
fillpoly(n,pts) ; 

UNTIL  list^jtr  «  nil; 

deallocate_logo_list; 

END; 


BEGIN 

{  no  initialization  section  ) 
END. 
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*  *- 

*  PROGRAM  NAME  -•  Omega  Perf  onnance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Wortetation  * 

*  * 

*  UNIT  NAME  -  WCmCMAP^Unit  * 

*  * 

*  * 

*  Ihis  program'  was:  pr^3ared>^by  * 

*  * 

*  Ihe  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Beading,  Massachusetts  01867  * 

*  * 


*  PACE  has  been  developed  to  run  on  a  IBM  PC/AT  or  ccnpatible  * 

*  under  MS-DOS  3.3  or  higher  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccnpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  un^  contract  number  * 


*  DIOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Cnega  Navigation  System  Center  (CNSCEN) ,  Alexandria,  VA.  * 

*  * 

★**★★★*★****★***** ***★★★★*★★★★*★*★*♦**★★***★★*★1^  ★**★★★★**★★***★***★***** 
*  * 

*  PURPOSE  * 

*  This  unit  contains  utility  routines  for  initializing  * 

*  and  displaying  the  world  nep  and  conversion  utilities  * 

*  for  lat/lon  to  screen  conversion.  * 

*  * 


UNIT  VforldMap; 

INIERFACE 

USES 

Gr^,  Errlog; 
TYPE 

xypt  =  RECORD 
x,y:  integer; 

END; 


VAR 

M^__Center, 

Screen^Center, 
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Scale_Factor  :  xypt: 

H^OCEECRE  OmTvertJIto_Screen_Positim(xin, yin;  integer;  VAR  xcxct,yout: integer)  ; 

{  ocnverts  frcm  real  wrarld  coordinates  to  screen  coordinates  } 

{  accounting  for  current  zoon  level  and  current  screen  center  } 

PROCEDURE  Ccaivertjrto__Real_Position(xin,  yin;  Integer;  VAR  xout^yout;  integer) ; 

{  converts  from  screen  coordinates  to  real  world  coordinates  } 

{  accounting  for  current  zocm  level  and  current  screen  center  } 

PROCEDURE  InitWorldMap; 

{  reads  in  ma^  points  } 

CONST 

NUMMAPPIS  =  7500; 

TYPE 

ma^pt  =  I^EOCRD 
dtype:  diar; 
lat,  Icn;  Integer; 

END; 


VAR 

fme^:  file  (*of  iiiappt*) ; 

Me^J^Points;  array[l.  .NUMMAPPIS]  of  m^pt; 

IMPIEMENIATION 


PROCEDURE  ConvertJIO_Scre€nJPositicai(xin, yin: integer;  VAR  xout, yout: integer) ; 

{ 

★★★★★★■A***************************************************************** 


* 

* 

* 

* 

* 

* 

* 


* 

PURPOSE  * 

converts  fron  real  world  coordinates  to  screen  coordinates  * 
inputs  are  lat/lon  in  deg*100  units  * 

accounting  for  current  zcan  level  * 

* 

* 


************************************************************************* 


BEGIN 


^  ***************************************************************  ■*'*'***»iit*iit******x* 

not  needed  as  of  04-09-90  for  the  PACE  project. . . 

CASE  Sel_Map  OF 

Mercator_Projection;  BEGIN 

IF  xin  <  -18000  IHEN  xin  ;=  -18000; 

IF  xin  >  18000  THEN  xin  ;=  18000; 
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XDUfc  :=  X^MeroatX!r[xin  DIV -50]  j 
yout  :=  y_lfercator[yin  DI7  25] ; 
END;  ~ 


CQ}_Prpjecticn:  BEX3N 

*********************************************************»*********»***»****) 


XDut  :=  ( (xLn  -  SczeenjOenter.x)  DIV  Scale^Eactjcar.x)  +  lfc^_Oenter.x; 
yout  :=  Map_Oenter.y  -  ( (yin  -  ScxeenjDenter.y)  DIV  Scale_RK3tor.y) ; 


IKXJrnRE'  QxwertJIto_Iteal_I^iticxi(xin^yin;]liteger;  vaR*XDUt,yout: integer) ; 

{ 

************************************************************************ 


* 


* 


* 

* 

* 

* 

* 


HIRPOSE  * 

converts  fron  scxeai  coordinates  to  real  vxarld  coordinates  * 
accounting  for  current  zocm  level  and  current  screen  center* 
output  is  in  lat/lon  in  units  of  deg*l00  * 

* 


* 


* 


************************************************************************ 


) 

EEXHN 


(************************************************************************ 
not  needed  as  of  04-09-90  for  the  PACE  project. . . 


CASE  Seljiap  OF 

Mercator_Projection;  BEXHN 
xout  ;=  -360; 

WHnZ  (X_}iercator(xout]  <  xin)  AND  (xout  <  360)  DO  Inc  (xout)  ; 
xout  :=  xout  *  50; 
yout  :*  -360; 

WHILE  (Y_Mercator[yout]  >  yin)  AND  (yout  <  360)  DO  Inc(yout) ; 
yout  ;=  yout  *  25; 

END; 


CEDJProjection:  BEXHN 


xout  ;=  ( (xin  -  Map_Center.x)  *  Scale_Factor.x)  +  Screen_Center.x; 
yout  ;=  Screen_Center.y  -  ((yin  -  M^_Center.y)  *  Scale_Factor.y) ; 


END; 


procedure  InitWbrldM^; 
{ 
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************************************************************************ 


*  * 

*  HIRPOSE  * 

*  Initialize  the  unit  setting  default  zcxn  levels,  etc  * 

*  * 


************************************************************************ 

) 


var 

i:  Integer; 
NvanRead  :  word; 


begin 

for  i  ;=  1  to  NDMMAEPIS  do 
Map_Points[i]  .Dt^^  :=  'Z'; 

{$!-) 

assign(fms^,  'World.inc^')  ; 
reset (fmap,SizeOf(Me^_Points) ) ; 

{$!+) 

if  IQResult  =  0  then  begin 
BlockRead(fitE^,MapJEtoints,Si2eOf  (MapJEOints)  ,NuniRead) ; 
if  NumRead  »  0  then  begin 
i  :=  0; 

while  i  <  NOMMAEPIS  do  begin 
Inc(i) 7 

with  Mc^__Points[i]  do  begin 
Lat  ;=  lat  *  10; 

Ion  ;=  Ion  *  10; 

if  lat  >  9000  then  Lat  :=  9000; 

if  Lat  <  -9000  then  Lat  ;=  -9000; 

if  Lon  >  18000  then  Ion  :=  18000; 

if  Ion  <  -18000  then  Ion  ;=*  -18000; 

end; 
end; 

close  (fmap)  ; 
end 

else  begin 

Log_,ErrDr( ^Problem  reading  Map  Data') ; 
end 
end 
else 

Iog_Error('File  World.M^  NCT  POUND')  ; 

end; 


{  load  the  map  point  data  into  memozy  } 
{  initialize  to  invalid  type  } 


BEGIN 
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ScieenJCenteriX  :=  Oy 
ScreenjCJenteriy  :=  0; 


(*  ‘!iap‘:(XX3niimtes'  are'^relativertortltea.*) 

(*  center- at  (0,0)  *) 


Scale_factor.x  :=  56; 
Scalejfactor.y  :=  58; 


(*  initial  scale  factor  setting  that  *) 
(*  xitilizes  the  v*ole  screen  *) 


MgpjCenter.x  ;*=  320; 
ME?)jCenter.y  175; 

END. 


(*  Ihis  represents  the  center  of  the  *) 
(*  screai  in  EGA  mocae  640  x  350  *) 
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APPENDIX  G 
QRBIJILD  LISTINGS 


This  appendix  contains  the  Pascal  code  listingTor  the.QR  bnilder  program.  A  discussion  of  this 
program  is  provided  in  Section  5.4. 


File  Niaine:  QREDILD.SRC 


graCHD  pragrzaa-  iJS«  the*  foHowingrsaurtse.** 
program  files  as  well  as  other  FACE  units:- 


CPBDUD.PAS 

CPCCMEUT.PAS 

CPDTrL.EaS 
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*  * 

*  PPOGSAM  NAME  -  Ckoega  Perfomance  Assessment  * 

*  and  * 

*  Uiverage  Evalmticn  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME  -  C2RBUILD  Program  * 

*  * 

************************************************************************ 
*  * 

*  This,  program  was  pr^aared  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massachusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  IM  PC/AT  or  conpatible  * 

*  under  MS-DCS  3.3  or  higher  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccnpatihle  graphics  adapter  and  color  * 

*  '  monitor.  This  work  was  performed  under  contract  number  * 

*  nr0323-89-C-20008,  Thsk  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Croega  Navigation  System  Center  (OISCEN) ,  Alexai^dria,  VA.  * 

*  * 

************************************************************************* 
*  * 

*  HJRPOSE  * 

*  This  program  serves  as  an  editor  for  the  station  reliability* 

*  values,  a  builder  for  precoiputing  QR  matrix  sets,  and  an  * 

*  archiver/loader  for  QR  set  archive  management.  * 

*  * 


*************************************★**********************************] 

{$fH-,E+} 

program  QR_tiuilder_and_station_reliability_editor__f or_PACE ; 

Uses  PaceInit,DCS,Crt,ConMan,Controls,Paceobjs, 

cursrchj ,  Graph,  ErrLog,QRampit,(33Jtil,TascIogo; 


Const 

me  =  cyan;  { 
mbc  =  black;  { 
be  =  white;  { 
he  =  blue;  { 
sc  =  yellow;  { 
tc  =  blaak;  { 
htc  =  white;  { 
stc  =  black;  { 
ems  =  18;  { 


menu  color  ) 

menu  border  color  } 

button  color  } 

hilite  color  ) 

selected  color  ) 

te>.t  color  ) 

hilited  text  color  ) 

selected  text  color  ) 

edit  menu  spacing  constant  ) 
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DEFaDIirQI?FIIi:^=  'EEEMJETiQR'; 

VAR-^ 

{  Really  wanted  to  declare  montho^jarams  an  array  of  monthofreliabilities 
but. . .  it  would  be  a  forward.  I  fake  it  out  later  by  filling  it  in 
using  monthofparamsinit,  an  array  of  monthofreliabilities 
(defined  later).  } 

montho^params:array[1..12]  of  ^Control; 

(SRDatabase:  QRDatabaseiype; 

SaveCrnroent :  OcnmentAceaT^  ; 

TXFE 

MonthOfReliabilities-  =  cbjectCoontrol) 

iinschedul^,scheduled/maintenanoe:  Array  [1..8]  of  NumberButton; 
Construc±or  Init; 

Function  Action (3{5pos,Ypos: word)  tboolean; virtual; 

Procedure  Shcw;virtual; 

Procedure  Hiliite (Xpos , Ypos ; word)  /virtual; 
end; 


MonthSelectionBar  =  object  (MUtExclusiveN) 

function  Action(}^x»,Ypos:wDrd)  /boolean; virtual; 
end; 


Function  MonthSelectionBar.Acticin(Xix3s,Ypos:word)  /boolean; 
{ 


★  * 

*  PURPOSE  * 

*  Action  method  for  the  user  month  selection  bar.  * 

*  * 


) 

VAR 

i;  integer; 

currentlyselected;  integer; 
begin 

FCR  i  ;=  1  to  NumberButtons  DO 
IF  ButtonArray[i]. selected  THEN 
currentlyselected  ;=  i; 

IF  MutE>£ClusiveN. Action (J$x3s, Ypos)  THEN 
begin 

deletefrrmcontext  ( 'basescreen'  ,mcnthofparams(currentlyselecT:ed] ) ; 
FOR  i  :=  1  TD  NumberButtons  DO 
IF  ButtonArray[i] .Selected  THEN 
begin 

(show  the  parameters  for  the  month  seleccad  } 
addtocontext('basescreen',monthofparams[i]) ; 
montiiofparams  (i]  ^ .  shew; 
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end; 


end; 

end; 


Constructor  MonthOfReliabilities.Init; 
{ 


•k 

* 

* 

* 


PURPOSE 

Initialization^  for  the  object  that  contains  reliability 
values  for  a  month  for  all  stations. 


* 

* 

* 

* 


} 

VftR 

i;  integer; 
begin 

control .  init  (30 , 100 , 100 , 100  ,;«Mte) ; 

PC»  i  ;=  1  to  8  DO 
begin 

unscheduled[i].Init(X+  20,Y+(i-l)*eras,110,10,bc,hc,tc,htc,0.0,l,10)  ; 
scheduled(i].Init  (X+220,Y+(i-l)*enB,110,10,bc,hc,tc,htc,0.0,l,10) ; 
inaintenance[i]  .Init(X+420,Y+(i-l)*€sns,110,10,bc,hc,tc,htc,0.0,l,10) ; 
enit 
end; 


Function  Month0fReliabilities.Action(}^)os,1^x3s:wDrd)  sboolean; 

{ 

************************************************************************* 


*  * 

*  HIRPOSE  * 

*  Action  method  for  the  object  that  contains  reliability  * 

*  values  for  a  month  for  all  stations.  * 


★*********************************************************************** 

} 

VAR 

i: integer; 
dunnyrboolean; 
s; string; 
begin 

K®  i  ;=  1  to  8  DO 
begin 

IF  unscheduled[i].Action(I^X5S,Ypos)  THEN 
begin 

Action  ;=  TRUE; 

IF  unscheduled[i]  .value  >  1.0  TEEN 
unsaieduled[i] .value  :=  1.0; 

str(unsdieduled[i]  .value:\r!saieduled[i]  .int;unscheduled[i]  .frac,s) ; 
Hide_Cursor; 

unscheduled[i]  .ChangeName(3) ; 
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ShcwM5icsor(3^p^  ;  • 

end; 

IF  sciieduled[i]  . Action (3$x3s,XPOs)  THEN 
begin 

Action  HUE; 

IF  scheduled[i] -value  >  1.0  THEN 
scheduled[i] -value  ;=  1.0; 

str(sciieduled[i]  .V2due:scheduled[i]  .int:scheduled[i]  .frac,s)  ; 
HidejCursor; 

scheduled[i]  .CbangeName(s} ; 

Show_CXirsor(3$)os,Ypos) ; 
end; 

IF  inaintenance[i]  .Action(]^X9G,^^x3S)  THEN 
begin 

Action  ;*  TRUE; 

IF  nBintenance[i]  -value  >  1.0  THEN 
maintenanoeCi] -  value  :*  1.0; 

str(naintenanceCi3  .value:inaintenance[i]  .int;itaintenance[i]  .frac,s) 
Hide_Cursor; 

maintenance  [i]  .CbangeNaine(s) ; 

Show__Cursor(}<iX3s,Ypos) ; 
end; 
end; 
end; 


Procedure  MonthOfReliabilities.Show; 

{ 

************************************************************************* 


*  * 

*  HJRPOSE  * 

*  Display  method  for  the  object  that  contains  reliability  * 

*  values  for  a  month  for  all  stations.  * 


*******************>•*★★****★******************************************** 

} 

VAR 

i:  integer; 
begin 

settextjustify(lefttext,toptext) ; 
setcolor  (blade) ; 

outtextay(unsc±eduled[13  .X,unscheduled[13  .Y-eins*2,  ^UNSCHEDULED^ ) ; 
outtextxy(unscheduled[l].X,unscheduled[l].Y-€ms,  'ITOBABILITY') ; 
outtext:Q^(scheduled[13.X,scheduledCl].Y-€ms*2,  'SCHEDULED^ ; 
cuttextxy(scheduled[l]  .X,scheduled[13  .Y-ems,  'rRDBABHITY') ; 
outtextxy(iiaintenance[lj  .X,maint&Tance(13  .Y-ems*2,  'MAINTENANCE') ; 
cuttextxy (maintenance (13  .X, maintenance ( 13  .Y-ems,  'ERDBABILETY') ; 

PCR  i  :=  1  to  8  CO 
begin 

unsc±ieduled(i3  .Shew; 
scheduled[i3  .Shew; 
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maintenance  [i]  .Shcwr 
settextjijstify(lefttext,tcpte}d:) ; 

outtext!Q^(urjsciieduled[i].X  -  15,unschec3uled[i]  .Y+2,stationnaines[i]) ; 
outtext3<y(sciieduled[i3.X  -  15, scheduled [i]  .¥+2, stationnaites[i] ) ; 
ciutte)ctxy(inaintenanoe[i]  .X  -  15,incdntexance[i]  .y+2,stationncates[i])  ; 
end; 
end; 


Procedure  MontfaOfReliabilitiesvHilite  (}ipcs  ^Ypos ; word) ; 

{ 

*  * 

*  ropposE  * 

*  method  for  the  object  that  contains  reliability  * 

*  values  for  a  month  for  eill  stations.  * 

************************************************************************** 

} 

VAR 

i:  integer; 
begin 

K3R  i  ;*  1  to  8  DO 
begin 

uns<dieduled[i]  .HiLite(J{Jx:s,Ypos) ; 
scheduled[i]  .HiLite(X^,Ypos) ; 
maintenancefi] . Hitite (X^xas ,  Ypos) ; 
end; 
end; 


VAR 

{  The  following  declaration  is  used  only  to  'help'  load 
up  the  monthofparams  array  with  the  pointers  to  the 
correct  object  types.  This  is  done  this  way  becai;ise 
monthofpar^  is  an  array  of  control  object  type  pointers,  not 
nonthofreliability  type  pointers,  so  it  cannot  be  used  in  the 
new  statement  for  initialization.  ) 
monthofparamsinit;arrayC1..12]  of  ^MonchOfReliabilities; 


{$F+) 

procedure  filebutton; 

{ 


*  -k 

*  PURPOSE  * 

*  Action  procedure  to  enable  the  file  menu  context,  * 

*  W 


kicif'k'X'kifkit'xkkick'xkitifkitickkiskJtifigicie^'kkickicic'Kic'k'kkic'fckieie’ycvtic’it^'Xiek^xyc'xyt'kicie'x^it'fC'jf^'K^K^yc 

} 

begin 
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pushcxatitext('filanenu') ; 
showcontext; 
end; 

procedure  quitbutton; 

{ 


*  * 

*  HIRPCSE  * 

*  Action  procedure  for  tMe^quit  button.  * 

*  * 


************************************************************************ 

} 

begin 

QUIT  ;*  1HIE; 
end; 

procedure  savebutton; 

{ 


*  it 

*  lUREOSE  * 

*  Action  procedure  to  enable  the  save  menu  context.  * 

*  * 


itiiit**itirkirk**itiiit**ii**ii**itiiirk*irkirk**it*irk*****it***-k**ie**itit******it*********it 

) 

begin 

SavdfenuWiixJoi^.MemoBox.GetNes/Itext(SaveCt!inrten^  ; 
pushcontext  ( '  savemenuwindcw' ) ; 
showcontext; 
end; 

procedure  catpute_and  write  QR; 

{ 

************************************************************************ 


*  * 

*  PURPOSE  * 

*  Action  procedure  that  controls  the  ccnputation  of  the  QR  * 

*  set  aixi  writes  it  out  to  a  QR  save  file.  * 


******★*********★****★**★**★****★***★***★*■***★***★★*★*****★****★**★***** 

} 

VAR 

QR_file;file  of  QRDatabaseType; 

coverage,ncm,i, j  .xx,yy;  integer; 

s,m;  string; 

dirinfo;  searchrec; 

filename  :  string; 

dir:  dirstr; 

name;  namestr; 
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ext:  extstr; 
begin 

{  At  this  point,  we  should  have  a  Tread  chosen  the  QR  file  to  write 
to,  and  should  aimeady  have  entered  a  comment  to  store 
at  the  beginning  of  the  file.  } 

{  the  following  code  is  a  first  cut  until  the  save  pep  iqp  window 
is  finished.  CHECK  THIS  ODCE  WHEN  THE  SAVE  POIUP  WINDOW  IS 
FINISHED  !!!!!! I ! i !!!!!!!!!! !!  } 

{  write  the  reliability  values  to  the  QRDatabase  first  } 

PCR  i  :«=  1  TO  12  DO 
FCR  j  :»  1  TO  8  DO 
begin 

CPDatabase.stationreliabilitiesfi, j,l]  :*= 
MonthOfParainsInit  [  i  unscheduled  [  j  ].  value ; 

QRDatabase.stationreliabilities[i, j,2]  := 
MonthOfParainsInit[i] .scheduled[j  ]  .value; 
QRDatabase.stationreliabilities[i, j,3]  :* 
MonthOfParainsInit  [  i]  .maintenance  [j  ] .  value ; 

end; 


{  The  Pa  values  will  be  stored  in  the  follcwiiig  order; 
the  'best  case'  Pa  numbers  for  stations  A.  .H  for  January 
the  'best  case'  Pa  numbers  for  stations  A.  .H  for  Febnary 


the  'best  case'  Pa  numbers  for  stations  A..H  for  December 
the  'nominal  case'  Pa  numbers  for  stations  A.  .H  for  January 
the  'nominal  case'  Pa  nunhers  for  stations  A.  .H  for  February 


the  'noninal  case'  Pa  numbers  for  stations  A.  .H  for  December  ) 

{  First  catpute  the  'best  case'  which  does  not  use  maintenance 
probabilities  in  the  probability  of  scheduled  off  air.  The  ixroinal 
case,  done  second,  uses  the  sum  of  tte  maintenance  probability  and 
scheduled  off  air  for  the  total  probability  of  scheduled  off  air. 

} 

{  pop  up  a  little  status  window  } 

messagebcx.di^laymessage(  (GetMaxX  DIV  2)  -  (textwidth( 'Building  Nominal  case  for  Jan' 

(GetMaxY  DIV  2)  -  (textheight('l') ) , 

1, 

length ( ' Building  Ncsainal  case  for  Jan'), 

lightred, 

white, 

{  Pun  through  each  month  and  catpute  the  QR  values  for  that  month's 
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File  .Nane:  QRBOEED.PAS 

particular-  reliability  numbers' } 

PGR  Nom  :=  d  TO  1  DO  {  0:  do  not  incliJde  maint,  1:  include  maint  ) 
begin 

IF  nan  *  0  TEJEN 
s  :*  'BEST' 
else 

S  :=  'NCMINAL'; 

H3R  i  :*  1  TO  12  DO 
begin 

m  :='MorTthNaines[i]  7 
messag^xK  .-redi^layiDessage  ( 1 , 

length  ('Building  Noninal  case  for  '}, 

' Building--' 4at'-  case  ;for-  '-Hn);.; 

(  Ocpy  the  scheduled  and  unscheduled  maintenance  probabilities 
fd’  each  station  into  the  data  area  in  the  QR  builder.  } 

FOR  j  :*  1  to  8  DO 
begin 

{  the  scheduled  and  unscheduled  arrays  in  QRCCMPOT  are  indexed 
[0..7],  so  subtract  one  fran  the  iixiex  } 

{  Ciis  is  kind  of  idLudgie  but  ...  lianthOfParams  and 
MonthOfFaramsInit  contain  the  same  set  of  pointers.  I  really 
want  to  use  the  McnthOfParams  array  here  BUT,  it  is  not 
visible  since  it  is  defined  belov.  So...  I'll  cheat  a 
little  and  use  MonthOfParamsInit  instead.  } 
sched[j-l]  :■  MonthOfParamsInit[i]''.scheduled[j]. value  + 

MonthOfParamsInit[ii''.jnaintenance[j]. value  *  nom? 
unsched[j-l]  :«  MonthOfParaiiBlnit(i]^.unscheduled[j]. value? 
end?  {  FOR  j  :»  1  TO  8  ) 

{  now  do  the  C2R  ccrputation  for  this  month  } 

Conpite_QR? 

{  ani  store  the  results  in  the  QRDatabase  } 

IF  nan  »  0  {  BEST  CASE  }  THEN 
FOR  coverage  ;*  0  To  255  DO 

(yDatabase.Best[i, coverage 3  :=  QR(coverage3 

ELSE 

FCR  coverage  :*  0  To  255  DO 

QRDatabase.Nonfi, coverage]  QR(coverage] ; 
end?  {  FOR  i  ;=  1  TO  12') 
end?  {  KR  ncm  0  TO  1  ) 
messagebcoc .  hidemessage  ? 

{  new  write  the  entire  QR  database  record  to  the  QR  file  ) 

filename  :=  SaveMenuWindow^.FileButtcn.TextjString? 

fsplit(filename, dir, name, ext)  ? 

filename  :=  name  +  ext; 

if  filename  =  "  then 

begin 

messagebax.displaymessage(  (GetMaxX  DIV  2)  - 

(textwidth( 'Please  Select  An  Appropriate  Filename  before  saving. . . DIV  2) , 
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GetMax^  DIV  2,1, 

length  (^Please  Select  An  Agprcpriate  Filename  before  saving. . . 

,  lightred,  white, 

'Please  Select  An  i^^aropriate  Filename  before  saving. . . ; 

beep; 

messagewait; 

messagdxK.hidemessage; 

end 

else 

begin 

Sav^Msnii(findcvr.MemoBoK.AssignChangec2rext(SaveCcniment) ; 

messagebax.displaymessage( (GetMaxX  DIV  2)  -  (textwidth( 'Saving  to  file:  '-KJRPATH+'X' 

(GetMaxS:  DIV  2)  -  (texthei^t('l')  DIV  2), 

length  ('Saving  to  file:  '+QRPA2Hf'\'+filenaroe) , 

Hatred, 

white., 

'Saving  to  file:  '-HjpPAIHf '\'+filename)  ; 

Assign  (QR_File,QE®AIHf'\'+filenanKi) ; 

Rewrite (S^^file) ; 

QRDatabase .  Comment  :«  SaveCanment; 
write {QR_f ile , QRDatabase) ; 

Close  (QR__File) ; 
messagebox . hidemessage ; 

hidecontext;  pcpcontext;  (*  wipe  out  the  save  memo  window  *) 
hidecontext;  pcpcontext;  (*  wipe  cut  the  file  pick  list  drop  down  menu  *) 
end 
end; 


procedure  loadbutton; 
{ 


*  * 

*  PURPCSE  * 

*  Action  procedure  to  activate  the  load  mer,u  context  for  * 

*  the  loading  of  existing  QR  sets.  * 


************************************************************************ 

> 

begin 

pushcontext('listmenu')  ; 
shcwcontext; 
end; 


Procedure  listmenuview; 

{ 

************'*i«**********5ln,***********.*******************.**************** 
*  * 

*  HJRPCSE  * 

*  Action  procedure  for  displaying  the  ccmment  that  is  stored  * 
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*  %dtlj  a  CR^sefei  * 

*A*A*********************A********«***********************************A* 

) 

VSR 

taiifrtxing;  oconentaxeatype; 

F:  file; 
dunn^:  <±ar; 
begin 

IF  listaiwnu^  .dijectCTylist.piciCBd  >  0  IHQf 
begin  {  read  -aie,  stuff  in  ) 

Assign  (F,ggatte-^\^4listmenu^.selectfrifile) ; 

Reset  (F^Sizeaf(ociaiieHtareatype)-) ; 

Bl<xkb^(^>taips|bdng,l}-; 

Close(F);^ 

messagr^xoc.  di^laymessage  (listnenu''  .X-100 ,  listxaenu''  .yf30 , 5,50,  e'en,  blade,  tenpstring 
r^»at 

until  loeypressed  OR  (get_buttans  o  0) ; 

IF  keypressed  IHEN  dunn^  readkey; 
messagdxu.hidemessage; 
end 
ELSE 
begin 

(  indicate  and  error  condition  that  no  file  is  selected  } 
be^; 
end; 
end; 


procedure  listmenuactiai; 
{ 


*  * 

*  HJRPOSE  * 

*  Action  procedure  to  select  a  QR  set  for  loading.  * 

*  * 


) 

VSR 

i,j:  integer; 
begin 

{  Get  the  name  of  the  arduve  to  read  fron  the  listmenu  and 
read  the  parameters  and  the  archive  data  into  the  exitmenu 
or  auxeditmenu  areas  (depending  v?)on  which  is  currently  active 
in  the  split  screen  or  on  the  main  screen)  and  fill  in  the 
a^xrepriate  cell  grid  data  for  the  hours  selected  in  the  loaded 
parameters  ) 

IF  listmenu''. directorylist. picked  >  0  IHEN 
begin  {  read  the  staff  in  } 

ReadQrDatabase (listmenu^ . selectedf ile,  @QRDatabase) ; 

{  new  assign  the  data  into  the  number  buttons  ) 
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File  CRBUUD.EAS 


PCR  i  :=  1  TO  12  DO 
R»  j  ;=  1  TO  8  DO 
begin 

Mart±Ofl%ffanBlnit[i]^.unsciieduled[j]. value  := 
flpDatabase.stationrp.l  iabil  ities[i,  j  ,1] ; 
MonQ30fRgangInit[i]^.schBduled[j]  .value  := 
GPD5rtabase.staticnreliabilities[i,j  ,2] ; 
Mantii0fBaransInit[i3^ .maintenance[ j  ]  .value  := 
CPDatabase.statioro:eliabilities[i,  j  ^3] ; 

end; 

{  pep  down  the  list  senu  } 

CenoelOontext; 

{  pep  down  the  file  menu  } 

CanoelOontext; 

{  and  reshow  the  base  screen  } 

ShowOontext; 

end 

ELSE 

begin 

{  indicate  and  error  condition  that  no  file  is  selected  ) 
beep; 
end; 
end; 


procedure  stub; 
{ 


*  * 

*  HJRPCSE  * 

*  amny  method  action  procedure  used  for  debug.  * 

*  * 


************************************************************************ 

} 

begin 

pushcontext(^stub^)  ; 
shcwcontaxt; 
end; 

{$F-3 


VPR 

gmede,  grdriver:  integer; 

X,Y: integer; 

button : integer ; 

index, station, key;  integer; 

labelarraytnamearray; 

monthselector:  ''MonthSelectionBar; 

f ilemenunamelist ;  PickMenuNameitoray ; 

f  ilemenuprccedurelist :  Pick^^enuActicnArray ; 


G-13 


File  N^:  C^^BOIIC.PAS 


folemenuiiotki^lisl;: 

Begin 

Grdriver  :=  Detect; 
Initgr2?4i(grtSriver,grnode, ' ; 
Setgr2$±anode(EGAHI) ; 


(* 

setf  illstyle  (widedotfill ,  dari<gray) ; 
bar(0,0,getaEO«,getina^) ; 
setoolor(bIue) ; 

r8ctangle(0,0,getinaxx,getiDa:^} ; 
Di^layr&scLogo  (40 , 50>  0.6); 

*) 


SetActivePage(l) ; 

SaveCcranent  := 

{  base  screen  and  controls  } 

nes/(basescreen,  Init  (0 , 0 , 639 , 349 ,  lic^itblue,  white,  1) ) ; 
new(h,Init(25, 4, 60, 16, white, black, black, white, ^Heip',stub,  'H') ) ; 
new(q,Init(105,4,60,16,viute>black,black,white,  'Quits qiiitbiitton,  "2S ) ! 
new(f,Init(l85,4,60,l6,white,black,black,viiite,  'FileS filebutton,  'F') )  ; 

{  file  menu  ) 

filemenunamelistfl]  ;*  'lead'; 
filemenunamelistC23  ;«  'Save'; 
filanenuhotkeylistil]  :=  'L'; 
f ilemenuhotkeylist [ 2 ]  :*  'S'; 
filemenuprooedurelistCl]  :=  loadbutton; 
filemeni:procedurelist[2]  :=  savetutton; 

new(fileinenu,Init(f''  .X,  f'' .  Y+f^  .Heic^it+5,2,  filemenunamelist,  filememprocedurelist,  filenenu 

new(Sav^ienuWindcw,  Init  (110, 145, 418 , 100,  cyan,black,  white, black, 

black,black,  white,defaultfont,  (inpite_And_Write_QR, 

'DEFADII.QR'))  ; 


FCR  index  :=  1  TO  12  EO 
begin 

{  initialize  with  object  of  type  ncnthofreliabilities  and 
copy  into  object  of  type  control.  ) 
new  (nonthofpar2inisinit[  index] ,  Init) ; 
iDonthofparanis[  index]  :*=  itonthofparainsinit(  index] ; 
end; 

{  Initialize  the  reliabilities  with  the  defaults  of  table  2.1-1  contained 
in  TASC  TIfl-5834-1-1,  March  1990.  All  values  not  initialized  here 
are  initialized  to  zero  in  the  object  instantiations.  ) 
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File  Name;  (3CB0IID.PA5 


R3R  index  :=  1  TO  12  DO  {  initialize  all  unscheduled  protis  to  0.001  } 
FCR  station  ;*  1  TO  8  DO 


Manth0fParainsInit[iix3ex]''.unscheduled[station]  .value  :=  0.001; 

FCR  index  :=  1  TO  12  DO  {  initialize  scheduled  probs  to  station  dep.  valvise  } 
begin 

McnthDfParainsInit[index]^.scheduled[l] .value  ;=  0.00269; 
MonthO£FaramsInit[index]^.schec^ed[2] .value  0.00037; 
MonthDfBaramsInit[index]^.sciieduled[3]. value  ;=  0.03604; 
Manth0fRa3risInit[indexi^.scheduled[43.valiie  0.00024; 
MonthOfParainsInit[index]‘^.scheduled[53 .value  ;=  0.00163; 
MonthOfPara!nsInit[index3'^.scheduled[63 .value  :=  0.00030; 
MonthOfBaramsInit[index3^. scheduled [7 3  .valtte  :=  0.00061; 
M3nthOfParamslnitiindex3''.scheduled[83  .value  :=  0.00005; 


end; 

{  rxM  do  the  station/month  dependent  maintenance  off  air  probs-  } 
ManthOfParamsInit[83''.maintenance[13  .value  :*  0.11057;  {  station 
MonthOfPaxaiiisInit[23''.iiiaintenanceC23. value  :=  0.34569;  {  station 
MonthOfParamsInit[63^.maintenanoe[33 .value  ;=  0.28628;  {  station 
MonthOfParamsInit[73''.maintenance[43. value  :=  0.07895;  {  station 
McinthOfParamsInit[93^.inaintenan(3e[53  .value  0.61490;  {  station 
MonthOfParainsInit[33^.inaintenance[63.value  :=  0.20511;  {  station 
MonthOfPazamsIrdt[113^.maintenance[73 .value  :»  0.01726; {  station 
hlkaTthOfParainsInit[103^.iiaintenzuioe[83. value  :*  0.32515; {  station 


A 

B 

C 

D 

E 

F 

G 

H 


in 

Aug 

} 

in 

Feb 

} 

in 

Jun 

) 

in 

Jul 

} 

in 

Sep 

} 

in 

Mar 

) 

in 

Nov 

} 

in 

Oct 

) 

FCR  index  ;=  1  to  12  DO 

labelarray[index3  :»  MonthNames[index3; 

new(manthselector,init(70,325,35,10,bc,hc,sc,tc,htc,stc,  'MCMH',12,l,labelarray,hori2onta 

r)ew(  listmenu,Init(filemenu''.buttonarray[13.X, 

fileinenu''.buttonarrayC13 .y+85,  cyan, black, listmenuview, 
listroenuaction,QRPAIiff ,  '*.QR') ) ; 


new(stufcwindcw,init) ; 

QRdatabase. conment  :=  'Default  QR  parameter  set.  GRDesrochers,  5/31/90.'; 

SetActivePage(O) ; 

createcontext(  'basescreen' ) ; 
addtocontext('basescreen' , basescreen) ; 

{  addtocontext(  'basescreen'  ,h) ; ) 
addtocontext( 'basescreen', q) ; 
addtocontext( 'basescreen ',f) ; 
addtocontext(  'basescreen'  ,monthselector) ; 

addtoconcaxt( 'basescreen' ,monthofpararos[13) ;  (  start  off  with  JAN  } 

{  addtotablist(  'basescreen'  ,h) ; ) 
addtocablist ( 'basescreen' ,  q) ; 
addtotablist(  'basescreen' ,  f ) ; 
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PGR.  inc3ex*  1  to  8  DO  begin 

addtotablist ( ^basescreen^ , @43itt^fParainsInit[13 ^ .unscheduled [ index] )  ; 
2»adtotablist(^basesca?een',@McinthDfParamsInit[l]‘'.scheduled[index]) ; 
addtotablist('basescreen',®ionthO£ParaffisInit[l]^.maintenance[index])  ; 
end; 

PCR  index  :=  1  To  12  DO 

addtotablist('basesczeen^,®fanthSelector^.ButtonArxay[index]) ; 

careat«X3ntext('filemenu') ; 
addtocontext  ( '  f ilemenu' ,  f ilemenu) ; 

{  addtocontext (^fileraenu'  ,h) ; ) 
addtoccntext('fileinenu^,g) ; 

auadtcrt2blist(  'f ilemenu' ,  §fiieinenu''  .buttonarray[l] ) ; 

2uJdtotablist-( 'fileroem' , efilemenu'^.buttonarray[2] ) ; 

{  addtotablist ('filetnenu'  ,h) ; } 
addtotablist ( '  f ilemenu' ,  q) ; 

crBateoontext('listinenu')  ; 
addtoconrt:ext('listmenu',listmenu) ; 

{  addtocontext (' listmenu', h) ;} 

addtocontext ('listmenu',q)  ; 

addtotablist ( 'listmenu' ,  glistmenu''  .DirectoryMasJcButton) ; 

PGR  index  :»  1  TO  maxlistsize  DO 

addtotablist( 'listmenu' , @listmenu''.directorylist.buttonarray[index] ) ; 
addtotablist  ( '  listmenu' ,  @listmenu'' . VBar.  Up) ; 
addtotablist  ( 'listmenu' ,  @listmenu^  .VBar.  Down) ; 
addtotablist ( 'listmenu' ,  @listmenu'' . Viev^itton) ; 
addtotablist ( 'listmenu' ,  glistmenu'^  .loadEutton) ; 

{  addtotablist(  'listmenu'  ,h) ; } 
addtotablist  ( '  listmenu ' ,  q) ; 

createcontext  ( '  saveanenuwindcw' ) ; 
addtocontext  ('savemenuwindow'  ,Sav^fenuWindcw) ; 

{  addtocontext (' savemenuwindcw', h) ;} 

addtocontext ('savemenuwindcw',q) ; 

addtotablist  ( 'saveroenuwindow' ,  Qsavemenuwindow''  .2femoBox) ; 
addtotablist  ( '  savemenuwindcw' ,  @saveinenuwindcw'' .  FileEutton) ; 
addtotablist  ( 'saveanenuwindow' ,  @savememwindohr  .SaveButton) ; 

{  addtotablist(  'savemenuwindow'  ,h) ; ) 

addtotablist ('savemenuwindow',q) ; 


createcontext  ('stub') ; 
addtocontext (' stub ',stubwindow) ; 

pushcontext('basescresn') ; 

ShcwContext; 

shcw_cursor{300,200) ; 
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QUIT  :=  FaiSE; 

repeat 

begin 

Get__Ifey{Key)  ; 
getjC3irsorXy(X,y) ; 

IF  (Key  IN  _Qirsor_set)  THEN 
Move_Cursor(Key,  X,  Y); 

HiLiteOQntext(X,Y) ; 
button  :*  get_buttons; 

IF  (button  »  left_buttonj3ressed)  C3R  (3oey  =  ENTER)  THEN 
ActianOontext(X,Y) ; 

IF  (button  «  ri^j3Utton_pressed)  OR  (key  =  ESC)  THEN 
CancelOontext; 

if  (key  o  0)  then  {  key  has  been  pressed. . .  } 
KeyActionOontext(X,  Y,  key)  ; 
end 

until  GJIT; 
restorecrtinode  ; 
end. 
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I ************************************************************************ 

*  * 

*  IKX3?AM  NAME  -  CJnega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evaluation  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NAME  -  QROMEUr  Uhit  * 

*  * 

*  * 

*  Biis  > program  vras^-prepaned-  by:  * 

*  * 

*  Die  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading^  Massadtiusetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  <31  a  IBM  PC/AT  or  ccnpatible  * 

*  under  MS-DOS  3.3  or  hic^ier  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccnpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  Dr0323-89-C-20008,  ISsk  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (C^CEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 

★  ★ 

*  FUPPCSE  * 

*  Biis  unit  contains  the  code  for  actually  building  a  QR  * 

*  set  for  use  within  PACE.  The  heart  of  the  Psa  algorithm  * 

*  ocnpjtations  are  performed  here.  * 

*  * 

****★*★****★***★*'*★***■**■****★**★■******★★***•*★*************★★★*****★*****  j 

{$N+) 

UNIT  QRCCMEUr; 

Interface 

VAR 

unsdied:  array [0.. 7]  of  single?  {  unscheduled  off  air  probabilities  by  station  ) 
sched:  array(0..7]  of  single?  {  scheduled  off  air  prciabilities  by  station  ) 

QR;  ARRAy[0..255]  OF  single? 

Procedure  CcsnpucejQR; 

Implementation 

VAR 
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R:  ARRAy[0..255]  OF- single? 

{  TuBarProducts  holds  results  of  prod(j=l  to  n)P(TuBarij)  and  is  indexed 
by  ijklmnop  (from  Rijklmncp) .  Ihis  is  part  of  the  equation  for 
Rijkltnnop  cn  p.  A-IO  } 

TuBarProducts  :  ABRAY[0..255]  OF  single? 

{  PofTsW  holds  results  of  P(lbarSi}c  TilTi2.  .Tin) ,  and  is  indexed  by  k  and 
the.  ccoplement  of  ijldmncp  (frcro-Rijklinncp) .  See  equation  A.1-11  } 
PofTSW  :  ARRay[0.,7,0..255]  of  single? 

(  PofW  holds  the  results  of  P(Til,Ti2/... Tin-1)  and  in  indexed  by 
ilklamcp,  the  cxxnbination,  of  stations..that  are  off  air  (frcsn  Rijklranop) . 
Ihis  holds  the  results  of  equation  A.  1-12  } 

PofW  :  ARRAy[0..255]  of  sii^le? 


FROCEEURE  Caipace_NRFs? 
{ 


*  * 

*  PURPOSE  * 

*  Hus  procedure  cotputes  the  network  reliabilil^  factors  (NRFs)  * 

*  for  a  given  set  of  reliability  numbers.  Since  the  reliability  * 


*  numbers  for  a  given  station  are  indexed  by  month,  the  ccdculations  * 

*  are  performed  for  201  months  and  for  all  station  combinations.  Hie  * 

*  results  are  used  in  the  cotputation  of  PA  *  P(X3) .  Hie  algorithm  * 

*  given  below  is  based  ipon  Appendix  1  of  TASC  TR-5351-8-1,  Omega  * 

*  System  Performance  Assessment,  March  1989  (also  listed  as  report  * 

*  no.  OS-<a^SCEN-01-89) .  In  particular,  equations  A.1-11,  A.  1-12,  and  * 


*  the  general  eipression  for  the  NRF  contained  on  p.  A-10  of  the  * 

*  r^xirt  are  used.  * 

*  * 

*  CSlDesrochers  5/9/90  initial  ceding  * 

*  * 

*  * 


*★************★*★****★**'*■)***■*★★★'****★*********■*  ★**■***•*★**★*****★*71,  ******* 

} 


vm 

on_air_vector:  byte; 

intermediate_sum, partial_product:  single? 
i,j,k:  integer? 

f irst_an_air ,  on_air ,  calculation_index ,  recursive_index :  cryte  ; 
partial_j3rcduct_formed:  bcclean; 

begin 
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{  Hie  foUcwijig  Icxp' ccnpites  the -Tu^  quantitiesi 

For  each  particxilar  index,  the  ponoducts  of  the  unscheduled  off  air 
probabilities  is  ccoputed  for  the  stations  whose  index  bit  is  set.  For 
exanple,  for  index  10101010  (decimal  170) ,  HiBarEroducts[l70]  = 
U1*U3*05*U7,  where  Ui  is  the  unscheduled  off  air  probability  for 
station  i  } 

PCR  i  :*  0  To  255  DO 
begin 

TUBarEroducts[i3  ;=  1; 

FCR  j  ;»  0  TO  7  DO 

IF  (i  SHL  j)  AND  $80  «  $80  THEN  {  if  this  term  is  in  this  product  ) 
TUBarProducts[i]'  ;*'^TUBarProducts[d]  *  vinsched[j]; 

end; 


{  The  following  loop  ccnputes  all  ocnbinations  of  equation  A.  1-11. 

Some  ccnputed  terms  are  never  used,  but  it  is  easier  to  caipite 
them  anyway  and  just  ignore  them  later  } 

FCR  i  :*  0  TO  255  DO 
begin 

cn_air  :■  0; 

WHUE  on_air  <=  7  DO  {  continue  until  all  on  airs  for  this  vector  are  calculated  } 
begin 

MHUJE  (i  AND  ($80  SHR  on_air)  *  0)  AND  (on_air  <»  7)  DO 
inc(cn_air) ; 

IF  an_air  <»  7  THEN  {  if  there  is  another  on  air  for  this  on  air  vector  ) 
begin 

calculation_index  i  XCR  ($80  SHR  Qn__air) ; 

PofTsW[on_.air,calculation__index)  ;*  1; 

FCRj:»OTO7DO 

IF  (calculatian__index  SHL  j)  AND  $80  =  $80  THEN  {  if  this  term  is  in  tiiis  pro 
PofTsW[on_air,calculation_index]  ;* 

PofI^W(on__air,calculation_index]  *  (1  -  unsched[j]); 
PofEsW[on_air,calculation__index]  ;*=  PofTsW[on_air,calculation_index]  *  sched[on_ 
inc(on_air) ;  {  bunp  to  the  next  station  ) 
end; 

end;  (  V2IILE  on_air  <»  7  ) 
end; 


{  The  following  section  ccnputes  the  results  of  equation  A.  1-12 
far  all  canbinations  of  Tij  stations  and  stores  them  in  the 
PofW  ejrray.  The  ccnputation  has  been  re-ordered  frtan  the 
equation  A.  1-12  form  to  the  follwai.g; 

P(Til  Ti2  . . .Tin)  *  P(Ti2  Til  . . .Tin) (l  -  ?(Til) ) 

-  P(Til) (prcd  j  =  2  to  n) (1  -  P{Tij)) 


This  allows  the  use  of  the  results  of  the  previous  loop  that 
ccnpites  PofIsW  because  the  final  term  in  the  above  expression 
is  eguavalent  to  equation  A.  1-11  as  shown  below. 
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P(Til)  (prod  j  =  2  to  n)  (1  -  P(Tij))  =  PofrsW[l,  (i2  i3  ...in)] 

Uie  loop  also  uses  the  results  of  the  previous  iterations  to  build 
the  next  term.  Hxis  handles  the  recursion  relationship  in 
equation  A. 1-12. 

) 

FOR  i  ;=  0  TO  255  DO 

PofW[i]  :»  1;  {  initialize  all  entries  ) 

PCR  i  :=  1  TO  255  DO 
begin 

(  First  find  the  first  indicated  station  by  finding  the  first 
bit  that  is  on.  Save  the  results.  } 
first jcnjair  :=  0; 

WHUe"” (i*AND  ($80  SHR  first_on_air)  *  0)  AND  (first_on_air  <  7)  DO 
inc(first_on__air) ; 

recursive__index  :»=  i  XDR  ($80  SHR  first_on_air) ; 

PofW[i]  ;*  PofW[recursive_index]  *  (1  -  unsched[first_on_air]) 

-  PofTsW(firstjon_eiir,recursive_index] ; 

end; 


{  New  cenpute  the  NRFs  for  all  caitoination  of  station  off  airs  } 

FOR  i  ;=  0  TO  255  DO 
begin 

on_air_vector  :=  i  XDR  $FF; 
intermediate_sum  ;»  0; 

FOR  j  ;*  0  TO  7  DO 

IF  i  AND  ($80  SHR  j)  o  0  THEN 
begin 

partial_product  :=  1; 
partial_product_formed  ;=  FALSE; 

FOR  k  0  TO  7~D0 
IF  i  AND  ($80  SHR  k)  o  0  THEN 
begin 

partial_prcduct__formed  ;=  TRUE; 

IF  j  =  k  THEN 

particil_product  partial_product  *  PofTsW[k,on__air_vector] 
else 

partial_product  :=  partial_product  *  unsched[k3 ; 
end;  {  FOR  k  :=  0  TO  7  ) 

IF  partial  j3rcduct__formsd  THEN 

incermediate_sum  :=  intarmediate_sum  -  pa2:tial_prcduct; 
end;  {  FOR  j  :=  0  TO  7  ) 

R[i]  :=  PofW[cin_air_vector3  *  TuBarPrcductsri3  -f  incermediate_sum; 
end; 
end; 
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Procedure-  Ccanput:e_QR; 


HJRPOSE  * 

Hiis  routine  ircplements  the  calculation  of  the  Pa  values  for  * 

individual  cells.  It  uses  the  followii>g  formula  * 

* 

Pa  =  P(X3)  =  QORO  +  QiRi  +  QijRij  +  ...  +  QijklmRijklm  * 

* 

where  the  Qi  factors  are  binary  valued  local  coverage  elements  * 
that  indicate,  for  a  particular  on  air  condition  of  all  ei^t  stations,* 
vdiether  a  cell  is  ^covered'  by  the  given  combination  of  station  * 
subscripts,  and  the  Ri  factors  are  the  network  reliability  factors.* 

* 

The  Qijklm  factors  are  read  as  the  probability  that  * 

three  or  more  station  signals  are  accessible  given  that  stations  * 
i,j,k,l,m  are  off  eiir  for  a  given  set  of  stations  that  cover  that  * 
cell.  For  exanple,  if  a  cell  is  covered  fcy  stations  A,  B,  C,  and  D,* 
QABC  =  0  because  only  D  is  left  covering  the  cell,  whereas  QAEPGH  =  1* 
because  the  cell  is  still  covered  fcy  BCD.  * 

* 

The  Rijklm  factors  are  read  as  the  network  reliability  factor  * 
when  stations  ijklm  are  off  air.  These  are  computed  separately  * 
for  all  combinations  of  ijklm.  * 

* 

The  abroach  for  caiputing  PA  for  each  cell  is  as  follows:  * 

* 

1.  Given  a  reliability  set  for  each  statioiVroonth  that  * 

indicates  the  probability  of  scheduled  and  unscheduled  * 

off  air  probabilities,  calculate  and  save  all  possible  * 

Rijklm  values  (there  are  219  of  them  total) .  These  are  * 

saved  in  a  256  element  array  that  is  indexed  fcy  the  * 

combinations  of  ijklmncp.  Some  of  the  antries  are  null  * 

fciecause  for  fewer  than  3  stations  on  air,  the  network  * 

reliability  factor  is  0  (there  are  256  -  219  =  37  entries  * 
equal  to  0) .  * 

* 

2.  For  each  station  coverage  condition  (e.g. ,  say  a  cell  is  * 

covered  by  stations  ABC) ,  and  for  each  month,  * 

form  the  sum  indicated  atxjve,  using  the  Rijklm  values  from  (1* 
and  evaluating  the  Qijklm  quantities  for  each  iteration  * 
of  each  summation  on  the  flv.  * 


3.  Store  each  PA  quantity  ccmputed  above  in  a  two  dimensional 
data  structure  indexed  fcy  station  coverage  and  month. 
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************************************************************************* 

) 

VAR 

cciveragejvector,off_air_vector:  byte; 

function  signal_accessible:  boolean; 

VAR 

i, j,canbination:  byte; 
begin 

ccntoination  :*  ooveragejvector  AND  (off_air_vector  XCR  $FF) ; 
i  :=  0; 

FDR  j  :=  0  TO  7  DO 
begin 

IF  (ccctoination  SHR  j)  AND  $01  >  0  THEN 
inc(i) ; 

end; 

IF  i  >=  3  THEN 

signaljaccessible  :=  TRUE 
ELSE 

signal_acx:essible  :*  FALSE; 

end; 


begin 

{  First  ccnpite  the  network  reliability  factors  for  this  month  of 
station  r^iability  numbers.  } 

Caipite__NRFs; 


{  Next  form  the  conbinations  of  the  NRFs  using  the  binary  values 
for  the  Qs.  Here,  each  Q  is  indicated  by  a  vector  that  contains 
a  bit  for  each  station.  For  exanple,  the  Q  vector  01110001 
indicates  that  stations  B,  C,  D  and  H  are  off  air,  denoted 
Q(  01110001) .  Ihus,  for  a  particular  Q  vector  and  a  given  coverage 
vector  (a  vector  indicating  which  stations  are  covering  the  cell) , 
the  value  of  the  Q  is  determined  by  caroaring  the  station  coverage 
vector  and  the  off  air  vector.  If  three  or  more  of  the  same  bits 
in  each  vector  are  the  same,  the  value  for  that  Q  is  1  and  the 
corresponding  R  term  is  included  in  the  suny'prcduct.  Ihe  R  term 
is  selected  using  the  Q  off  air  vector  for  each  term.  } 

FX3R  coverage_vector  :=  0  TO  255  DO 
begin 

QR[coverage_vector]  :=  0; 

FX2R  off_air_vector  ;=  0  TO  255  DO 

begin 

IF  signal_accsssible  THEN 

QR[coverage_vector]  :=  QRfcoveragej/ector]  -r  R[off_air_veccor] ; 

end; 
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end;, 

end; 

begin 

{  no  initialization  section  ) 
end. 


File  Name:  QFUriL.PAS 


^  ************************************************************************* 


*  * 

*  HROGRfiM  NaME  -  Onega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evalmtion  * 

*  (PACE)  * 

*  Wortoatation  * 

*  * 

*  UNIT  NAME  -  QRUTIL  Unit  * 

*  * 


4r 

*  This  program  was  prepared  fcy 

* 

*  The  Analytic  Science  Corporation  (TASC) 

*  55  WalTters  Brook  Drive 

*  Reading »  Massachusetts  01867 

* 


* 

* 

* 

★ 

if 

* 

* 


*  PACE  has  been  developed  to  run  on  a  IHl  PC/AT  or  coipatible  * 

*  under  MS-DOS  3.3  or  hi^ier  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  B3A  or  ccnpatible  grajiiics  adapter  and  color  * 

*  monitor.  This  work  was  performed  xnider  contract  number  * 

*  DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Onega  Navigation  System  Center  (C»ISCEN) ,  Alexandria,  VA.  * 

*  * 


************************************************************************ 


*  * 

*  PURPOSE  * 

*  This  unit  contains  utili'^  routines  that  are  used  for  * 

*  accessing  the  QR  files  and  the  data  in  them.  * 

*  * 

*  * 


★★★A********************************************************?************  J 

UNIT  QRUTIL; 


Interface 


CONST 

Scheduled  =  1; 

Unscheduled  =  2; 

Maintenance  =  3; 

Type 

(***********  ncte:  the  following  type  definition  for  cciiimentareatype  MUST  be 
consistent  with  the  definition  of  the  ccininent  area  in 
the  PACEOBJS.PAS.  ***************) 
connentt^  =  string; 

QRDatabasePtr  =  ^QRDatabaseType; 

QRDatabaseiype  =  record 


G-25 


File  Name:  URLJTIL.EaS 


cxanent:  o;Jl■^l^alttvpe^ . 

stationrel labilities:  ARRA2f[1..12,1..8,l-«3]  OF  single; 

Best,Nan:  ARR»y[l.. 12,0.. 255]  OF  single; 
end; 

CPDatabaseSufcfl^pe  =  AKRMf[1..12,1..8,1..3]  OF  single; 

VRR 

ORPath:  stadng; 

Procedure  Ree4gg>atabase(gtfile:string;,Gggtj;gg)atabasePte  ; 

Proceduter  GetStationReliabil  ities.(yMt/stationrel  iabiliti.es;QRDatabase5ub!iype; 

Olfile:string)  •; 

Xnplanentation 


Procedure  PeadORDr>tabase(QRfile:string;QRPtr:QRDatal3asePtr) ; 

{ 

*  * 

*  HIRPOSE  * 

*  Biis  routine  reads  the  desired  C2R  set  and  stores  it  in  * 

*  memory  for  future  escess  hy  the  Psa  processing  rcutines.  * 

) 

VAR 

F:  File; 

errorstring  :  string; 
begin 

Assign(F,CSRPAn:!-'\'-K2RFile)  ; 

Reset(F,sizeof  (QRDatabaseiype) ) ; 

Blodcread  (F,  QRPtr- ,  1)  ; 

Close (F) ; 
end; 


Procedure  GetStationReliabilities(VAR  stationreliabilities:QRDatabaseSubiyper 

CSRfile:  string) ; 


*************'JMMk***********'iWt********'*****)>t*************'**‘***'*********** 


*  HJRPOSE  * 

*  To  retrieve  the  individual  station  reliabilities  values  * 

*  fron  the  QR  set.  * 

***************************************************************************** 


} 

VAR 

F:  File; 

errorstring  ;  string; 
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ccDDoent:  ccniaenttype; 
begin 

i^ign(F,C!RE5flHf'\'-K3RFile)  ; 

Reset(F,l)  /* 

Se^(F,Sizeof  (ocninent) } ; 

Bloctaead(F^stationre]  iabil  Ities^sizeof  (staticmreliabilities) } ; 
Close(F) ; 
end; 

begin 

{  no  init  section  } 
end. 
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GENGDOP  LISTINGS 


This  appendix  contains  the  Pascal  code 'listings  for  the  GDOP  database  generation  program.  A 
discussion  of  this  program  is  provided  in  Section  5.5. 
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!Il^’-(3Nj^gX3P  'pregram-':Usesrthe>-f63JLciwing:  source^ 
program-  files-as -well  as  oth^'-PAGE'  units: 

GEN  GDOP.PAS 
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*  * 

*  FROQWM  NRME  -  Cttega  Performance  Assessment  * 

*  and  * 

*  Coverage  Evalmtion  * 

*  (PACE)  * 

*  Workstation  * 

*  * 

*  UNIT  NMffi  -  The  GENQXDP  Program  * 

*  * 

*  * 

*  Hiis  program  was  prepared  by  * 

*  * 

*  The  Analytic  Science  Corporation  (TASC)  * 

*  55  Walkers  Brook  Drive  * 

*  Reading,  Massacda:isetts  01867  * 

*  * 

*  PACE  has  been  developed  to  run  on  a  HM  PC/AT  or  conpatible  * 

*  under  MS-DOS  3.3  or  higher  with  a  minimum  of  640K  of  main  * 

*  memory  and  an  EGA  or  ccnpatible  graphics  adapter  and  color  * 

*  monitor.  This  work  was  performed  under  contract  number  * 

*  DrOG23-89-C-20008,  Task  Order  90-0001,  Task  No.  5834,  for  * 

*  the  Omega  Navigation  System  Center  (OCCEN) ,  Alexandria,  VA.  * 

*  * 

************************************************************************ 
*  * 

*  PURPOSE  * 

*  This  file  contains  the  program  for  conputing  the  GCOP  * 

*  database.  The  resulting  file  is  delivered  with  the  PACE  * 

*  software  as  the  GDOP  database.  * 

*  * 

************************************************************************* j 

{ 

Generate  GCOP  program 

This  program  generates  the  GDOP  table  of  values  that  are  used 
for  coiputing  PSA  in  PACE.  The  table  is  generated  and  stored  by  cell 
number  (1  to  444)  and  by  coverage  vector  (0  to  255) .  The  total  GDOP 
file  can  be  interpreted  as  an  ARRAY[1.. 444,0.. 255]  OF  BYTE.  Each  GDOP 
value  is  stored  as  a  one  byte  quantity  that  r^sresents  the  actual 
GCOP  number  scaled  up  by  10.  Thus,  the  range  of  GCOP  values  in  the 
table  are  fran  0  to  25.5.  GDOP  values  above  25  are  all  assigned  the 
value  25.5  so  that  the  range  of  values  actually  runs  0..25  in  0.1 
increments,  and  25.5.  The  file  name  that  the  GDOP  table  is  stored  in 
is  called  GCOP.  GDP.  The  e:2Dression  'ised  to  calculate  the  GDOP 
quantities  is  as  follows; 
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sq5fe(  (sum(i=rl.  .q^l)-  (sumCj=i.  .q)^  (square(sin(  (Bi-Bj)./2-) ) )/ 
sum(i*l.  .q-2)  (sum('j=i-- .q-l)  (sum(3c=j-..q)- 

(squarB{siii(  (Bk-Bj)/2) )  * 
square(sin(  (Bi-Bk)/2) )  * 
square(sin(  {Bj-Bi)/2) ) ) )  )/2 


program  generate_thej3IX)Pjrable__forJPACE; 

USES  Oellvrtil; 

CONST 

stations:-  arEay[0..7,0. .1]  of  integer  ^- 
( (6642,1313) , 

(630,-1066) , 

(2140,-15783) , 

(4637,-9834) , 

(-2097,5529) , 

(-4305,-6519) , 

(-3848,14694) , 

(3461,12945)); 

GDOPfile  »  ^aXDP.ODP' ; 

EWCnCN  ArcCos(x  :  single)  ;  single; 

{ 

*********************** ******************************************'******* 


*  * 

*  HJRPOSE  * 

*  Ccnpute  the  arc  cosine  of  an  angle.  * 

*  * 


) 

BEIGIN 

ARCCCS  :=  Pi/2.0-Arqran(VSqrt(1.0-x*x))  ; 
END; 


FONCnCN  Get  Angle (Trlat  Int,  Trlon  Int,  Plat  Int,  Rlon  Int  :  Integer)  ;  single; 

{  ”  ' 
***![******************************************************************** 


*  * 

*  POPPOSE  * 

*  Ihis  function  returns  the  bearing  angle  fron 

*  (Plat_Int,Plon_Int)  to  (rrlat_Int,Trlon_Infc) .  * 

*  * 

*  * 


********************  **********************-X*************7»*************** 

} 
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RADBSt  =  0.0174532925; 


VRR 

Trlat,  Trlcai,  Rlat,  Rlon  :  single; 

IxanDiff,  Distance,  Per,  ISnl,  Sden,  Beta  :  single; 


PUNCncw  Scale  (X  :  single)  :  single; 

{ 

************************************************************************ 


*  * 

*  HIRPOSE  ^  * 

*  This  function  sinply  ccsnverts  fron^  degreesvto  radians.  * 

*  * 

«  * 


************************************************************************ 


BEGIN  {  Scale  ) 

Scale  :=  x*RADEGR 

END;  {  Scale  ) 


************************************************************************** j 


BEGIN 


{  Beginning  of  Get_Angle  ) 


{  Oanvert  latitudes/longitndes  to  their  real  values  (divided  ty  10)  ) 
Trlat  ;=  Trlat_lnt/100; 

Trlon  :«  Trlon~Int/100; 

KLat  :*  KLat_Int/100; 

Rlon  ;»  Rlon__Int/100; 


{  Ocnpite  the  bearing  angle  and  return  } 

Distance  :=  ArcCos (Sin (Scale (Trlat) )*Sin (Scale (rlat))+Cos (Scale (Trlat))* 
Cos  (Scale  (rlat) )  *Cos  (Scale (Trlon-Rlon) )  )/RADEGR; 
lonDiff  :=  Rlon-Trlon; 

IF  ABS (LonDiff)  >«  180 
then  if  LonDiff  <  0 

THEN  LonDiff  LonDiff+360 
ELSE  LonDiff  ;=  LonDiff-360; 

Per  :=  0.5*(180-Trlat-Rlat+Distance) ; 

Ttal  :*  Scale (Per-90) ; 

Sden  :=  Sin  (Scale  (Per)  )*Sin(Tinl+Scale  (rlat) )  ; 

IF  Sden  <=  0 
THEN  Beta  ;=  180 
ELSE  BEGIN 

Beta  :=  2*Arcian (Sort (ABS  (Sin (Tml+Scale  (Trlat)  )* 

Sin  (Scale  (Per-Distance) ) )  /Sden)  )/RADEGR; 

IF  LonDiff  =  0 
THEN  IF  Rlat^lat  <  0 
THEN  Beta  ;=  180 
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ELSE  Beta  :=  360-Beta 
ELSE  IF  LanDif f  >  0 
IHEN  Beta  :=  360-Beta 

END;  {  IF/IHEN/EISE  ) 

Get_Angle  :=  Scale (360-Beta) 


File  Naone;  GEN  (SX)P.PAS 


{  do  the  numerator  first  } 
numerator  0; 

FCR  i  :*  1  TO  numberangles  -  1  DO 
FCR  j  :*  i+1  TO  nunteerangles  DO 

numerator  ;*  numerator  +  sqr(sin({angle[i-l]-angle[j“l])/2)) ; 

{  now  do  the  denaninator  } 
denominator  0; 

FCR  i  :=  1  TO  numberangles  -  2  DO 
FCR  j  i+1  TO  nunberangles  -1  DO 
FCR  k  j+1  TO  nuirberangles  DO 
denaninator  :»  denaninator  + 

sqr(sin(  (angle[k-l]-angle[<j-l] ) /2) )  * 
sqr(sin( (angle[i-l]-angle[k-'l] )/2) )  * 
sqr(sin((angle[j-l]-angle[i-l])/2) ) ; 

IF  denominator  o  0  THEN 
begin 

{  scale  gdop  results  by  10  and  limit  between  0  and  20  in  increments  of  .1  ) 
result  :»  sqrt  ( numerator/denoninator )  /2 ; 

IF  result  >  25  IHEN 
result  ;*  25.5; 
ccnpute_gdcp  :*  result; 
end 
ELSE 

conpitejgdcp  :*=  25.5; 

end; 


end;  {  CASE  ) 
end; 

var 

tnplst:  cell_defn_ptr; 
lat ,  Ion ,  cellno ;  integer ; 
coverage;  byte; 

(3X>Parray;  array[0. .255]  of  byte; 
result;  single; 

F;file; 

begin 

(*********  Main  portion  of  the  GENGDOP  Program  **********■***) 

{  Initialize  the  cell  grid  lat/lcogs  ) 

ihitCellGrid; 

{  call  the  ccnpite  GDOP  routine  for  each 
station  conbination  for  each  cell  ) 

{  open  the  caXDP  file  and  write  the  results  ) 

assign (f,gdcpfile)  ; 

rewrite (f,sizeof(gdcparray) )  ; 

cellno  :=  1; 

tiiplst  :=  cell_lst; 
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WHILE  tnplst  o  NIL  DO 
]3egin 

Ion  :*  (tnplst''. lon2  +  tnplst^. lonl)  DIV  2; 
lat  :«  (tnplst''. Iat2  +  tnplst"'. latl)  DIV  2; 

FOR  coverage  :=  0  TO  255  DO 
begin 

result  ;=  10  *  (Xtputej3D0P(lcin, lat, coverage)  ; 

GDOParray[coverage]  ;=  rajnd(result) ; 

IF  result  >  255  THEN 
begin 

wri'teln( 'WANNING,  CCMEUIED  GEOP  >  25.5  FOR  coverage  vector  ', coverage) ; 
readin; 
end 
ELSE 
begin 

{  if  (result  >  10)  AND  (result  <  255)  THEN) 

writcln('#  ',cellno,'  lat  ',lat,'  Ion  ',lon,'  cov  ', coverage, '  GDOP  ',gdoparr 

end; 

end; 

{  write  the  values  cut  to  the  GDOP  file  } 
blockwrite (F, gdcparray , 1) ; 
inc(cellno) ; 
tnplst  ;»  tnplst^. next; 
end; 

{  aose  the  C3X)P  file  ) 
close (F) ; 

end. 
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